[m-rev.] for review 3/3: Update psqueue.m's interface to match other library
Paul Bone
paul at bone.id.au
Sun Dec 7 23:23:57 AEDT 2014
Branches: master
For review by anyone.
This patch is difficult to read as I've also re-ordered the clauses to match
the order of declrations in the file's interface. I will attach the
complete psqueue.m file.
---
Update psqueue.m's interface to match other library modules.
library/psqueue.m:
Make the psqueue interface more consistent with other standard library
modules.
tests/hard_coded/psqueue_test.exp:
tests/hard_coded/psqueue_test.m:
Update tests.
---
library/psqueue.m | 571 ++++++++++++++++++++------------------
tests/hard_coded/psqueue_test.exp | 3 +-
tests/hard_coded/psqueue_test.m | 57 ++--
3 files changed, 327 insertions(+), 304 deletions(-)
diff --git a/library/psqueue.m b/library/psqueue.m
index 481c02d..4a490cf 100644
--- a/library/psqueue.m
+++ b/library/psqueue.m
@@ -54,11 +54,21 @@
%
:- pred is_empty(psqueue(P, K)::in) is semidet.
+ % create singleton psqueue
+ %
+:- pred singleton(P::in, K::in, psqueue(P, K)::out) is det.
+:- func singleton(P, K) = psqueue(P, K).
+
% Insert key K with priority P into a priority search queue.
% Fail if the key already exists.
%
-:- func insert(P, K, psqueue(P, K)) = psqueue(P, K) is det.
-:- pred insert(P::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is det.
+:- pred insert(P::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is semidet.
+
+ % Insert key K with priority P into a priority search queue.
+ % Abort if the key already exists.
+ %
+:- func det_insert(psqueue(P, K), P, K) = psqueue(P, K) is det.
+:- pred det_insert(P::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is det.
% Peek at highest priority key, do not change the priority search queue.
%
@@ -70,18 +80,19 @@
% Remove element with minimal priority.
%
-:- pred del_min(P::out, K::out, psqueue(P, K)::in, psqueue(P, K)::out)
+:- pred remove_least(P::out, K::out, psqueue(P, K)::in, psqueue(P, K)::out)
is semidet.
% Remove element with minimal priority, call error/1 if priority search
- % queue is empty
-:- pred det_del_min(P::out, K::out, psqueue(P, K)::in, psqueue(P, K)::out)
+ % queue is empty.
+ %
+:- pred det_remove_least(P::out, K::out, psqueue(P, K)::in, psqueue(P, K)::out)
is det.
% Create an ordered association list from a priority search queue.
%
-:- func to_ord_assoc_list(psqueue(P, K)) = assoc_list(P, K).
-:- pred to_ord_assoc_list(psqueue(P, K)::in, assoc_list(P, K)::out) is det.
+:- func to_assoc_list(psqueue(P, K)) = assoc_list(P, K).
+:- pred to_assoc_list(psqueue(P, K)::in, assoc_list(P, K)::out) is det.
% Create a priority search queue from an assoc_list of priority, key pairs
%
@@ -90,32 +101,32 @@
% Remove element with specific key from a priority queue.
%
-:- func delete(K, psqueue(P, K)) = psqueue(P, K) is det.
-:- pred delete(K::in, psqueue(P, K)::in, psqueue(P, K)::out) is det.
+:- pred remove(P::out, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is semidet.
+
+:- pred det_remove(P::out, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is det.
% Adjust priority of specified element. The old priority is given as an
- % argument to the adjustment function.
+ % argument to the adjustment function. Fails if the element is not
+ % found.
%
-:- func adjust(func(P) = P, K, psqueue(P, K)) = psqueue(P, K) is det.
:- pred adjust((func(P) = P)::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out)
- is det.
+ is semidet.
- % Look-up the priority of the specified key.
+ % Search for the priority of the specified element.
%
-:- func lookup(K, psqueue(P, K)) = P is semidet.
-:- pred lookup(K::in, psqueue(P, K)::in, P::out) is semidet.
+:- pred search(psqueue(P, K)::in, K::in, P::out) is semidet.
% Lookup the priority of the specified key, calls error/1 if the element is
% not present.
%
-:- func det_lookup(K, psqueue(P, K)) = P is det.
-:- pred det_lookup(K::in, psqueue(P, K)::in, P::out) is det.
+:- func lookup(psqueue(P, K), K) = P.
+:- pred lookup(psqueue(P, K)::in, K::in, P::out) is det.
% Range query for all priority - key pairs less or equal to a specified
% priority
%
-:- func at_most(P, psqueue(P, K)) = assoc_list(P, K).
-:- pred at_most(P::in, psqueue(P, K)::in, assoc_list(P, K)::out) is det.
+:- func at_most(psqueue(P, K), P) = assoc_list(P, K).
+:- pred at_most(psqueue(P, K)::in, P::in, assoc_list(P, K)::out) is det.
% Return the size of the priority search queue as the number of elements.
%
@@ -205,40 +216,12 @@
l_right_tree :: ltree(K, P)
).
-%---------------------------------------------------------------------------%
-
- % create empty psqueue
- %
-psqueue.init = PSQ :-
- psqueue.init(PSQ).
-
-psqueue.init(void).
-
- % check for empty psqueue
- %
-psqueue.is_empty(void).
-
-
- % create singleton psqueue
- %
-:- pred singleton(K::in, P::in, psqueue(P, K)::out) is det.
-:- func singleton(K, P) = psqueue(P, K).
-
-singleton(K, P) = Res :-
- singleton(K, P, Res).
-
-singleton(K, P, PSQ) :-
- PSQ = winner(K, P, start, K).
-
+%-----------------------------------------------------------------------%
% extract maximal (highest priority) key
%
-:- func max_key(psqueue(P, K)) = K is semidet.
:- pred max_key(psqueue(P, K)::in, K::out) is semidet.
-max_key(PSQ) = K :-
- max_key(PSQ, K).
-
max_key(PSQ, MaxKey) :-
PSQ = winner(_, _, _, MaxKey).
@@ -297,327 +280,361 @@ second_best(LTree, Key) = Res :-
)
).
-to_ord_assoc_list(PSQ) = Res :-
- to_ord_assoc_list(PSQ, Res).
+%---------------------------------------------------------------------------%
-to_ord_assoc_list(PSQ, AList) :-
- ( psqueue.del_min(K, P, PSQ, PSQ0) ->
- to_ord_assoc_list(PSQ0, AList0),
- AList = [K - P | AList0]
+ % create empty psqueue
+ %
+init = PSQ :-
+ init(PSQ).
+
+init(void).
+
+ % check for empty psqueue
+ %
+is_empty(void).
+
+singleton(P, K) = Res :-
+ singleton(P, K, Res).
+
+singleton(P, K, PSQ) :-
+ PSQ = winner(K, P, start, K).
+
+%-----------------------------------------------------------------------%
+
+insert(P, K, !PSQ) :-
+ insert_tv(K, P, tournament_view(!.PSQ), !:PSQ).
+
+det_insert(P, K, !PSQ) :-
+ ( insert(P, K, !PSQ) ->
+ true
;
- AList = []
+ unexpected($file, $pred,
+ "error on inserting element into priority search queue")
).
-from_assoc_list(AList) = Res :-
- from_assoc_list(AList, Res).
-
-from_assoc_list(AList, PSQ) :-
- from_assoc_list2(AList, init, PSQ).
+det_insert(PSQ0, P, K) = PSQ :-
+ det_insert(P, K, PSQ0, PSQ).
-:- pred from_assoc_list2(assoc_list(P, K)::in, psqueue(P, K)::in,
- psqueue(P, K)::out) is det.
+:- pred insert_tv(K::in, P::in,
+ t_tournament_view(K, P)::in, psqueue(P, K)::out) is semidet.
-from_assoc_list2(AList, PSQ0, PSQ) :-
+insert_tv(IK, IP, TV, Res) :-
(
- AList = [],
- PSQ = PSQ0
+ TV = emptySet,
+ Res = psqueue.singleton(IP, IK)
;
- AList = [Pair | Rest],
- Pair = (Prio - Key),
- insert(Prio, Key, PSQ0, PSQ1),
- from_assoc_list2(Rest, PSQ1, PSQ)
+ TV = singleton(Key, Prio),
+ compare(CMP, IK, Key),
+ (
+ CMP = (<),
+ Res = tournament(psqueue.singleton(IP, IK),
+ psqueue.singleton(Prio, Key))
+ ;
+ CMP = (>),
+ Res = tournament(psqueue.singleton(Prio, Key),
+ psqueue.singleton(IP, IK))
+ )
+ ;
+ TV = tournament_between(T1, T2),
+ T1 = winner(_, _, _, MaxKey1),
+ T2 = winner(_, _, _, _),
+ ( IK `leq` MaxKey1 ->
+ insert(IP, IK, T1, Left),
+ Res = tournament(Left, T2)
+ ;
+ insert(IP, IK, T2, Right),
+ Res = tournament(T1, Right)
+ )
).
-det_del_min(MinPrio, MinKey, PSQ, NewPSQ) :-
- ( del_min(MinPrio0, MinKey0, PSQ, NewPSQ0) ->
- NewPSQ = NewPSQ0,
+%-----------------------------------------------------------------------%
+
+peek(PSQ, MinPrio, MinKey) :-
+ PSQ = winner(MinKey, MinPrio, _, _).
+
+det_peek(PSQ, MinPrio, MinKey) :-
+ ( peek(PSQ, MinPrio0, MinKey0) ->
MinKey = MinKey0,
MinPrio = MinPrio0
;
unexpected($file, $pred, "priority search queue is empty")
).
-del_min(MinPrio, MinKey, PSQ, NewPSQ) :-
+remove_least(MinPrio, MinKey, PSQ, NewPSQ) :-
PSQ = winner(MinKey, MinPrio, L, MaxKey),
NewPSQ = second_best(L, MaxKey).
-peek(PSQ, MinPrio, MinKey) :-
- PSQ = winner(MinKey, MinPrio, _, _).
-
-det_peek(PSQ, MinPrio, MinKey) :-
- ( peek(PSQ, MinPrio0, MinKey0) ->
+det_remove_least(MinPrio, MinKey, PSQ, NewPSQ) :-
+ ( remove_least(MinPrio0, MinKey0, PSQ, NewPSQ0) ->
+ NewPSQ = NewPSQ0,
MinKey = MinKey0,
MinPrio = MinPrio0
;
unexpected($file, $pred, "priority search queue is empty")
).
-:- pred leq(V::in, V::in) is semidet.
-:- pragma type_spec(leq/2, V = int).
-leq(ValLeft, ValRight) :-
- compare(CMP, ValLeft, ValRight),
- ( CMP = (>) ->
- fail
+%-----------------------------------------------------------------------%
+
+to_assoc_list(PSQ) = Res :-
+ to_assoc_list(PSQ, Res).
+
+to_assoc_list(PSQ, AList) :-
+ ( remove_least(K, P, PSQ, PSQ0) ->
+ to_assoc_list(PSQ0, AList0),
+ AList = [K - P | AList0]
;
- true
+ AList = []
).
-%---------------------------------------------------------------------------%
-% view types for min view, tournament view and tree view
-%---------------------------------------------------------------------------%
+from_assoc_list(AList) = Res :-
+ from_assoc_list(AList, Res).
-:- type t_min_view(K, P) --->
- empty
- ; min(K, P, psqueue(P, K)).
+from_assoc_list(AList, PSQ) :-
+ from_assoc_list2(AList, init, PSQ).
-:- type t_tournament_view(K, P) --->
- emptySet
- ; singleton(K, P)
- ; tournament_between(psqueue(P, K), psqueue(P, K)).
+:- pred from_assoc_list2(assoc_list(P, K)::in, psqueue(P, K)::in,
+ psqueue(P, K)::out) is det.
-:- type t_tree_view(K, P) --->
- leaf
- ; node(K, P, ltree(K, P), K, ltree(K, P)).
+from_assoc_list2([], !PSQ).
+from_assoc_list2([(Prio - Key) | Rest], !PSQ) :-
+ det_insert(Prio, Key, !PSQ),
+ from_assoc_list2(Rest, !PSQ).
-%---------------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
- % get min view of priority search queue
- %
-:- func min_view(psqueue(P, K)) = t_min_view(K, P) is det.
+remove(P, K, !PSQ) :-
+ remove_tv(P, K, tournament_view(!.PSQ), !:PSQ).
-min_view(PSQ) = Res :-
- (
- PSQ = void, Res = empty
+det_remove(P, K, !PSQ) :-
+ ( remove(PPrime, K, !.PSQ, PSQPrime) ->
+ P = PPrime,
+ !:PSQ = PSQPrime
;
- PSQ = winner(Key, Prio, LTree, MaxKey),
- Res = min(Key, Prio, second_best(LTree, MaxKey))
+ unexpected($file, $pred, "element not found")
).
- % get tournament view of priority search queue
- %
-:- func tournament_view(psqueue(P, K)) = t_tournament_view(K, P) is det.
+:- pred remove_tv(P::out, K::in,
+ t_tournament_view(K, P)::in, psqueue(P, K)::out) is semidet.
-tournament_view(PSQ) = Res :-
+remove_tv(Prio, Key, TV, Res) :-
(
- PSQ = void,
- Res = emptySet
+ TV = emptySet,
+ false
;
- PSQ = winner(K, P, LTree, MaxKey),
- (
- LTree = start, Res = singleton(K, P)
- ;
- LTree = loser(_, LK, LP, TL, SplitKey, TR),
- ( LK `leq` SplitKey ->
- Res = tournament_between(winner(LK, LP, TL, SplitKey),
- winner(K, P, TR, MaxKey))
+ TV = singleton(Key, Prio),
+ Res = void
+ ;
+ TV = tournament_between(TL, TR),
+ TL = winner(_, _, _, MaxKey1),
+ ( Key `leq` MaxKey1 ->
+ remove(Prio, Key, TL, Left),
+ Res = tournament(Left, TR)
;
- Res = tournament_between(winner(K, P, TL, SplitKey),
- winner(LK, LP, TR, MaxKey))
+ remove(Prio, Key, TR, Right),
+ Res = tournament(TL, Right)
)
- )
).
+%---------------------------------------------------------------------------%
- % get tree view of priority search queue
- %
-:- func tree_view(ltree(K, P)) = t_tree_view(K, P) is det.
+:- pred leq(V::in, V::in) is semidet.
+:- pragma type_spec(leq/2, V = int).
-tree_view(LTree) = Res :-
- (
- LTree = start, Res = leaf
- ;
- LTree = loser(_, LK, LP, LL, SplitKey, LR),
- Res = node(LK, LP, LL, SplitKey, LR)
+leq(ValLeft, ValRight) :-
+ compare(CMP, ValLeft, ValRight),
+ ( CMP = (<)
+ ; CMP = (=)
).
+%-----------------------------------------------------------------------%
-lookup(K, PSQ) = lookup_tv(K, tournament_view(PSQ)).
+adjust(F, K, !PSQ) :-
+ adjust_tv(F, K, tournament_view(!.PSQ), !:PSQ).
-lookup(K, PSQ, P) :-
- P = lookup(K, PSQ).
+:- pred adjust_tv(func(P) = P, K, t_tournament_view(K, P), psqueue(P, K)).
+:- mode adjust_tv(func(in) = out is det, in, in, out) is semidet.
-det_lookup(K, PSQ) = Res :-
- ( Res0 = lookup(K, PSQ) ->
- Res = Res0
+adjust_tv(Func, K, TV, Res) :-
+ (
+ TV = emptySet,
+ false
+ ;
+ TV = singleton(Key, Prio),
+ ( K = Key ->
+ Res = psqueue.singleton(Func(Prio), Key)
+ ;
+ Res = psqueue.singleton(Prio, Key)
+ )
;
- unexpected($file, $pred, "element to look-up is not present in\
- priority search queue")
+ TV = tournament_between(TL, TR),
+ TL = winner(_, _, _, MaxKey1),
+ ( K `leq` MaxKey1 ->
+ adjust(Func, K, TL, Left),
+ Res = tournament(Left, TR)
+ ;
+ adjust(Func, K, TR, Right),
+ Res = tournament(TL, Right)
+ )
).
-det_lookup(K, PSQ, P) :-
- P = det_lookup(K, PSQ).
+%---------------------------------------------------------------------------%
-:- func lookup_tv(K, t_tournament_view(K, P)) = P is semidet.
-lookup_tv(K, TV) = Res :-
+search(PSQ, K, P) :-
+ search_tv(tournament_view(PSQ), K, P).
+
+:- pred search_tv(t_tournament_view(K, P)::in, K::in, P::out) is semidet.
+
+search_tv(TV, K, Res) :-
(
- TV = singleton(Key, Prio),
- Key = K,
- Res = Prio
+ TV = singleton(Key, Prio),
+ Key = K,
+ Res = Prio
;
- TV = tournament_between(TL, TR),
- TL = winner(_, _, _, MaxKey1),
- ( K `leq` MaxKey1 ->
- Res = lookup(K, TL)
- ;
- Res = lookup(K, TR)
- )
+ TV = tournament_between(TL, TR),
+ TL = winner(_, _, _, MaxKey1),
+ ( K `leq` MaxKey1 ->
+ search(TL, K, Res)
+ ;
+ search(TR, K, Res)
+ )
).
-
-adjust(F, K, PSQ) = Res :-
- ( PSQ0 = adjust_tv(F, K, tournament_view(PSQ)) ->
- Res = PSQ0
+lookup(PSQ, K, P) :-
+ ( search(PSQ, K, PPrime) ->
+ P = PPrime
;
- unexpected($file, $pred, "error while adjusting priority of an element")
+ unexpected($file, $pred, "element not found")
).
-adjust(F, K, PSQ, PSQ0) :-
- PSQ0 = adjust(F, K, PSQ).
+lookup(PSQ, K) = P :-
+ lookup(PSQ, K, P).
-:- func adjust_tv(func(P) = P, K, t_tournament_view(K, P)) = psqueue(P, K)
- is semidet.
-adjust_tv(Func, K, TV) = Res :-
+%-----------------------------------------------------------------------%
+
+at_most(PSQ, P) = Res :-
+ at_most(PSQ, P, Res).
+
+at_most(PSQ, Pt, AList) :-
+ MView = min_view(PSQ),
(
- TV = emptySet, Res = void
- ;
- TV = singleton(Key, Prio),
- ( K = Key ->
- Res = psqueue.singleton(Key, Func(Prio))
- ;
- Res = psqueue.singleton(Key, Prio)
- )
+ MView = empty,
+ AList = []
;
- TV = tournament_between(TL, TR),
- TL = winner(_, _, _, MaxKey1),
- ( K `leq` MaxKey1 ->
- Res = tournament(adjust(Func, K, TL), TR)
- ;
- Res = tournament(TL, adjust(Func, K, TR))
- )
+ MView = min(_, Prio, _),
+ compare(CMP, Prio, Pt),
+ (
+ CMP = (>),
+ AList = []
+ ;
+ ( CMP = (=)
+ ; CMP = (<)
+ ),
+ TView = tournament_view(PSQ),
+ (
+ TView = emptySet,
+ AList = []
+ ;
+ TView = singleton(Prio0, Key0),
+ AList = [Key0 - Prio0]
+ ;
+ TView = tournament_between(T1, T2),
+ at_most(T1, Pt, AL0),
+ at_most(T2, Pt, AL1),
+ AList = AL0 ++ AL1
+ )
+ )
).
-insert(IP, IK, PSQ) = Res :-
- ( PSQ0 = insert_tv(IK, IP, tournament_view(PSQ)) ->
- Res = PSQ0
+size(PSQ, Size) :-
+ (
+ PSQ = void,
+ Size = 0
;
- unexpected($file, $pred, "error on inserting element into priority\
- search queue")
+ PSQ = winner(_, _, LTree, _),
+ Size = ltree_size(LTree)
).
-insert(IP, IK, PSQ, PSQ0) :-
- PSQ0 = insert(IP, IK, PSQ).
+size(PSQ) = Res :-
+ size(PSQ, Res).
-:- func insert_tv(K, P, t_tournament_view(K, P)) = psqueue(P, K) is semidet.
-insert_tv(IK, IP, TV) = Res :-
+:- func ltree_size(ltree(K, P)) = t_ltree_size.
+
+ltree_size(LTree) = Res :-
(
- TV = emptySet, Res = psqueue.singleton(IK, IP)
- ;
- TV = singleton(Key, Prio),
- compare(CMP, IK, Key),
- (
- CMP = (<), Res = tournament(psqueue.singleton(IK, IP),
- psqueue.singleton(Key, Prio))
- ;
- CMP = (=), Res = psqueue.singleton(IK, IP)
- ;
- CMP = (>), Res = tournament(psqueue.singleton(Key, Prio),
- psqueue.singleton(IK, IP))
- )
+ LTree = start, Res = 0
;
- TV = tournament_between(T1, T2),
- T1 = winner(_, _, _, MaxKey1),
- T2 = winner(_, _, _, _),
- ( IK `leq` MaxKey1 ->
- Res = tournament(insert(IP, IK, T1), T2)
- ;
- Res = tournament(T1, insert(IP, IK, T2))
- )
+ LTree = loser(Res, _, _, _, _, _)
).
-delete(DK, PSQ) = Res :-
- ( PSQ0 = delete_tv(DK, tournament_view(PSQ)) ->
- Res = PSQ0
- ;
- unexpected($file, $pred, "error while deleting an element")
- ).
+%---------------------------------------------------------------------------%
+% view types for min view, tournament view and tree view
+%---------------------------------------------------------------------------%
+
+:- type t_min_view(K, P)
+ ---> empty
+ ; min(K, P, psqueue(P, K)).
+
+:- type t_tournament_view(K, P)
+ ---> emptySet
+ ; singleton(K, P)
+ ; tournament_between(psqueue(P, K), psqueue(P, K)).
+
+:- type t_tree_view(K, P)
+ ---> leaf
+ ; node(K, P, ltree(K, P), K, ltree(K, P)).
+
+%---------------------------------------------------------------------------%
-delete(DK, PSQ, PSQ0) :-
- PSQ0 = delete(DK, PSQ).
+ % get min view of priority search queue
+ %
+:- func min_view(psqueue(P, K)) = t_min_view(K, P).
-:- func delete_tv(K, t_tournament_view(K, P)) = psqueue(P, K) is semidet.
-delete_tv(DK, TV) = Res :-
+min_view(PSQ) = Res :-
(
- (
- TV = emptySet, Res = void
- ;
- TV = singleton(Key, Prio),
- ( DK = Key ->
- Res = void
- ;
- Res = psqueue.singleton(Key, Prio)
- )
- )
+ PSQ = void,
+ Res = empty
;
- TV = tournament_between(TL, TR),
- TL = winner(_, _, _, MaxKey1),
- ( DK `leq` MaxKey1 ->
- Res = tournament(delete(DK, TL), TR)
- ;
- Res = tournament(TL, delete(DK, TR))
- )
+ PSQ = winner(Key, Prio, LTree, MaxKey),
+ Res = min(Key, Prio, second_best(LTree, MaxKey))
).
-at_most(P, PSQ) = Res :-
- at_most(P, PSQ, Res).
+ % get tournament view of priority search queue
+ %
+:- func tournament_view(psqueue(P, K)) = t_tournament_view(K, P).
-at_most(Pt, PSQ, AList) :-
- MView = min_view(PSQ),
+tournament_view(PSQ) = Res :-
(
- MView = empty,
- AList = []
+ PSQ = void,
+ Res = emptySet
;
- MView = min(_, Prio, _),
- compare(CMP, Prio, Pt),
- (
- CMP = (>),
- AList = []
- ;
- ( CMP = (=); CMP = (<) ),
+ PSQ = winner(K, P, LTree, MaxKey),
(
- TView = tournament_view(PSQ),
- (
- TView = emptySet,
- AList = []
- ;
- TView = singleton(Prio0, Key0),
- AList = [Key0 - Prio0]
- ;
- TView = tournament_between(T1, T2),
- at_most(Pt, T1, AL0),
- at_most(Pt, T2, AL1),
- AList = AL0 ++ AL1
- )
+ LTree = start,
+ Res = singleton(K, P)
+ ;
+ LTree = loser(_, LK, LP, TL, SplitKey, TR),
+ ( LK `leq` SplitKey ->
+ Res = tournament_between(winner(LK, LP, TL, SplitKey),
+ winner(K, P, TR, MaxKey))
+ ;
+ Res = tournament_between(winner(K, P, TL, SplitKey),
+ winner(LK, LP, TR, MaxKey))
+ )
)
- )
).
-size(PSQ, Size) :-
- (
- PSQ = void, Size = 0
- ;
- PSQ = winner(_, _, LTree, _),
- Size = ltree_size(LTree)
- ).
-size(PSQ) = Res :-
- size(PSQ, Res).
+ % get tree view of priority search queue
+ %
+:- func tree_view(ltree(K, P)) = t_tree_view(K, P) is det.
-:- func ltree_size(ltree(K, P)) = t_ltree_size is det.
-ltree_size(LTree) = Res :-
+tree_view(LTree) = Res :-
(
- LTree = start, Res = 0
+ LTree = start,
+ Res = leaf
;
- LTree = loser(Res, _, _, _, _, _)
+ LTree = loser(_, LK, LP, LL, SplitKey, LR),
+ Res = node(LK, LP, LL, SplitKey, LR)
).
%---------------------------------------------------------------------------%
diff --git a/tests/hard_coded/psqueue_test.exp b/tests/hard_coded/psqueue_test.exp
index 548c263..1a65a7d 100644
--- a/tests/hard_coded/psqueue_test.exp
+++ b/tests/hard_coded/psqueue_test.exp
@@ -2,6 +2,7 @@ empty test: ok
paper example test: winner("Lennart", 1, loser(7, "Phil", 3, loser(3, "Erik", 2, loser(1, "Charles", 4, start, "Charles", start), "Erik", loser(1, "Mary", 6, start, "Lennart", start)), "Mary", loser(3, "Simon", 5, loser(1, "Richard", 7, start, "Phil", start), "Richard", loser(1, "Warren", 8, start, "Simon", start))), "Warren")
at_most 4: sol([1 - "Lennart", 2 - "Erik", 3 - "Phil", 4 - "Charles"])
to_ord_assoc_list test: [1 - "Lennart", 2 - "Erik", 3 - "Phil", 4 - "Charles", 5 - "Simon", 6 - "Mary", 7 - "Richard", 8 - "Warren"]
-delete and to_or_assoc: [1 - "Lennart", 2 - "Erik", 4 - "Charles", 5 - "Simon", 6 - "Mary", 7 - "Richard", 8 - "Warren"]
+delete Phil: [1 - "Lennart", 2 - "Erik", 4 - "Charles", 5 - "Simon", 6 - "Mary", 7 - "Richard", 8 - "Warren"], 3
from_assoc_list: [0 - "M", 1 - "L", 2 - "B", 3 - "N", 4 - "H"]
Adjust: [1 - "L", 2 - "B", 3 - "N", 4 - "H", 10 - "M"]
+
diff --git a/tests/hard_coded/psqueue_test.m b/tests/hard_coded/psqueue_test.m
index e4f6e2a..81e56f2 100644
--- a/tests/hard_coded/psqueue_test.m
+++ b/tests/hard_coded/psqueue_test.m
@@ -11,13 +11,15 @@
:- implementation.
+:- import_module list.
:- import_module psqueue.
:- import_module set.
+:- import_module string.
:- pred test_psqueue_empty is semidet.
test_psqueue_empty :-
- psqueue.init(PSQ),
+ psqueue.init(PSQ `with_type` psqueue(int, int)),
psqueue.is_empty(PSQ).
:- pred test_empty(io::di, io::uo) is det.
@@ -43,20 +45,20 @@ test_paper_ex(PSQ_EX, !IO) :-
psqueue(int, string)::out) is det.
test_psqueue_paper_ex(!PSQ) :-
- psqueue.insert(8, "Warren", !PSQ),
- psqueue.insert(2, "Erik", !PSQ),
- psqueue.insert(7, "Richard", !PSQ),
- psqueue.insert(5, "Simon", !PSQ),
- psqueue.insert(4, "Charles", !PSQ),
- psqueue.insert(6, "Mary", !PSQ),
- psqueue.insert(3, "Phil", !PSQ),
- psqueue.insert(1, "Lennart", !PSQ).
+ psqueue.det_insert(8, "Warren", !PSQ),
+ psqueue.det_insert(2, "Erik", !PSQ),
+ psqueue.det_insert(7, "Richard", !PSQ),
+ psqueue.det_insert(5, "Simon", !PSQ),
+ psqueue.det_insert(4, "Charles", !PSQ),
+ psqueue.det_insert(6, "Mary", !PSQ),
+ psqueue.det_insert(3, "Phil", !PSQ),
+ psqueue.det_insert(1, "Lennart", !PSQ).
:- pred test_at_most(psqueue(int, string)::in, io::di, io::uo) is det.
test_at_most(PSQ_EX, !IO) :-
io.print("at_most 4: ", !IO),
- at_most(4, PSQ_EX, AList),
+ at_most(PSQ_EX, 4, AList),
io.print(set.from_list(AList), !IO),
io.nl(!IO).
@@ -64,40 +66,43 @@ test_at_most(PSQ_EX, !IO) :-
test_to_ord_list(PSQ_EX, !IO) :-
io.print("to_ord_assoc_list test: ", !IO),
- to_ord_assoc_list(PSQ_EX, AList),
+ to_assoc_list(PSQ_EX, AList),
io.print(AList, !IO),
io.nl(!IO).
:- pred test_delete(psqueue(int, string)::in, io::di, io::uo) is det.
test_delete(PSQ_EX, !IO) :-
- io.print("delete and to_or_assoc: ", !IO),
- delete("Phil", PSQ_EX, PSQ_DEL),
- to_ord_assoc_list(PSQ_DEL, AList),
- io.print(AList, !IO),
- io.nl(!IO).
+ ( remove(P, "Phil", PSQ_EX, PSQ_DEL) ->
+ to_assoc_list(PSQ_DEL, AList),
+ io.format("delete Phil: %s, %d\n", [s(string(AList)), i(P)], !IO)
+ ;
+ io.write_string("remove failed\n", !IO)
+ ).
:- pred test_from_assoc_list(psqueue(int, string)::out, io::di, io::uo) is det.
test_from_assoc_list(PSQ5, !IO) :-
io.print("from_assoc_list: ", !IO),
init(PSQ0),
- insert(4, "H", PSQ0, PSQ1),
- insert(1, "L", PSQ1, PSQ2),
- insert(2, "B", PSQ2, PSQ3),
- insert(0, "M", PSQ3, PSQ4),
- insert(3, "N", PSQ4, PSQ5),
- to_ord_assoc_list(PSQ5, AList),
+ det_insert(4, "H", PSQ0, PSQ1),
+ det_insert(1, "L", PSQ1, PSQ2),
+ det_insert(2, "B", PSQ2, PSQ3),
+ det_insert(0, "M", PSQ3, PSQ4),
+ det_insert(3, "N", PSQ4, PSQ5),
+ to_assoc_list(PSQ5, AList),
io.print(AList, !IO),
io.nl(!IO).
:- pred test_adjust(psqueue(int, string)::in, io::di, io::uo) is det.
test_adjust(PSQ, !IO) :-
- io.print("Adjust: ", !IO),
- adjust(func(_) = 10, "M", PSQ, PSQ0),
- to_ord_assoc_list(PSQ0, AList),
- io.print(AList, !IO).
+ ( adjust(func(_) = 10, "M", PSQ, PSQ0) ->
+ to_assoc_list(PSQ0, AList),
+ io.format("Adjust: %s\n", [s(string(AList))], !IO)
+ ;
+ io.write_string("Adjust failed\n", !IO)
+ ).
:- pred test_all(io::di, io::uo) is det.
--
2.1.3
-------------- next part --------------
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%---------------------------------------------------------------------------%
% Copyright (C) 2014 The Mercury Team
%
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: psqueue.m.
% Main author: Matthias Güdemann.
% Stability: low.
%
% This module implements a priority search queue ADT.
%
% A priority search queue (pqueue) provides both map-like and priority queue
% functionality in a single ADT. This combination is very powerful and
% useful in many situations.
%
% Psqueues map from priorities to keys and back. They
% provide methods to lookup the priority of a key, insert and delete
% priority-key pairs, adjust the priority of a given key and retrive the
% priority and key with the highest priority.
%
% The implementation here closely follows the description given in Ralf Hinze's
% paper "A Simple Implementation Technique for Priority Search Queues", ICFP
% 2001, pp. 110-121.
%
% The priority-key pairs are stored in a weight-balanced tree for efficient
% acces.
%
% read highest priority element: O(1)
% remove highest priority element O(log n)
% delete/insert/ajdust/lookup element: O(log n)
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module psqueue.
:- interface.
:- import_module assoc_list.
%---------------------------------------------------------------------------%
:- type psqueue(P, K).
% Create an empty priority search queue.
%
:- func init = psqueue(P, K).
:- pred init(psqueue(P, K)::out) is det.
% True iff the priority search queue is empty.
%
:- pred is_empty(psqueue(P, K)::in) is semidet.
% create singleton psqueue
%
:- pred singleton(P::in, K::in, psqueue(P, K)::out) is det.
:- func singleton(P, K) = psqueue(P, K).
% Insert key K with priority P into a priority search queue.
% Fail if the key already exists.
%
:- pred insert(P::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is semidet.
% Insert key K with priority P into a priority search queue.
% Abort if the key already exists.
%
:- func det_insert(psqueue(P, K), P, K) = psqueue(P, K) is det.
:- pred det_insert(P::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is det.
% Peek at highest priority key, do not change the priority search queue.
%
:- pred peek(psqueue(P, K)::in, P::out, K::out) is semidet.
% As peek/3, will call error/1 if the psqueue is empty.
%
:- pred det_peek(psqueue(P, K)::in, P::out, K::out) is det.
% Remove element with minimal priority.
%
:- pred remove_least(P::out, K::out, psqueue(P, K)::in, psqueue(P, K)::out)
is semidet.
% Remove element with minimal priority, call error/1 if priority search
% queue is empty.
%
:- pred det_remove_least(P::out, K::out, psqueue(P, K)::in, psqueue(P, K)::out)
is det.
% Create an ordered association list from a priority search queue.
%
:- func to_assoc_list(psqueue(P, K)) = assoc_list(P, K).
:- pred to_assoc_list(psqueue(P, K)::in, assoc_list(P, K)::out) is det.
% Create a priority search queue from an assoc_list of priority, key pairs
%
:- func from_assoc_list(assoc_list(P, K)) = psqueue(P, K).
:- pred from_assoc_list(assoc_list(P, K)::in, psqueue(P, K)::out) is det.
% Remove element with specific key from a priority queue.
%
:- pred remove(P::out, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is semidet.
:- pred det_remove(P::out, K::in, psqueue(P, K)::in, psqueue(P, K)::out) is det.
% Adjust priority of specified element. The old priority is given as an
% argument to the adjustment function. Fails if the element is not
% found.
%
:- pred adjust((func(P) = P)::in, K::in, psqueue(P, K)::in, psqueue(P, K)::out)
is semidet.
% Search for the priority of the specified element.
%
:- pred search(psqueue(P, K)::in, K::in, P::out) is semidet.
% Lookup the priority of the specified key, calls error/1 if the element is
% not present.
%
:- func lookup(psqueue(P, K), K) = P.
:- pred lookup(psqueue(P, K)::in, K::in, P::out) is det.
% Range query for all priority - key pairs less or equal to a specified
% priority
%
:- func at_most(psqueue(P, K), P) = assoc_list(P, K).
:- pred at_most(psqueue(P, K)::in, P::in, assoc_list(P, K)::out) is det.
% Return the size of the priority search queue as the number of elements.
%
:- func size(psqueue(P, K)) = int is det.
:- pred size(psqueue(P, K)::in, int::out) is det.
%---------------------------------------------------------------------------%
% These predicates may be used by the test suite to check the correctness of
% the implementation. They should always be true.
% True iff the priority search queue respects the semi heap properties:
%
% 1) the top element has the highest priority and
% 2) for each node of the loser tree, the priority of the loser is higher
% or equal to the priorities in the subtree from which the loser
% originates.
%
:- pred is_semi_heap(psqueue(P, K)::in) is semidet.
% True iff the priority search queue respects the search tree properties:
%
% 1) for each node the keys in the left subtree are smaller as or equal
% to the split key and
% 2) the keys in the right subtree are larger than the
% split key.
%
:- pred is_search_tree(psqueue(P, K)::in) is semidet.
% True iff maximal key and all split keys are present
%
:- pred key_condition(psqueue(P, K)::in) is semidet.
% True iff keys are unique.
%
:- pred is_finite_map(psqueue(P, K)::in) is semidet.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module int.
:- import_module list.
:- import_module maybe.
:- import_module pair.
:- import_module require.
%---------------------------------------------------------------------------%
% The PSQueue data structure uses the 'tournament' metaphore. Consider
% multiple compeditors playing matches, with the winners from each matches
% playing one another to find the champion. The winner is the item with the
% lowest priority. The data structure here follows a similar tree. However,
% two modifications are made:
%
% + First, a tournament tree contains the data in the leaves of the tree and
% repeats the winners within the tree. To avoid this duplication we do not
% store any information in the leaves and store the loosers internally within
% the tree. The champion is stored at the root node of the tree.
%
% + To facilitate sorting by key, sort keys are stored inside each node. The
% items in the left subtree have keys less than or equal to the sort key, the
% keys in the right subtree have keys greater than the sort key. The looser
% (stored in this node) is considered to be part of one of the two subtrees,
% depending how it's key compares with the sort key.
:- type psqueue(P, K)
---> void
; winner(
w_key :: K,
w_prio :: P,
w_loosers :: ltree(K, P),
w_max_key :: K
).
:- type t_ltree_size == int.
:- type ltree(K, P)
---> start
; loser(
l_size :: t_ltree_size,
l_looser_key :: K,
l_looser_prio :: P,
l_left_tree :: ltree(K, P),
l_sort_key :: K,
l_right_tree :: ltree(K, P)
).
%-----------------------------------------------------------------------%
% extract maximal (highest priority) key
%
:- pred max_key(psqueue(P, K)::in, K::out) is semidet.
max_key(PSQ, MaxKey) :-
PSQ = winner(_, _, _, MaxKey).
% Play tournament to combine two priority search queues, see Ralf Hinze's
% paper for explanantion.
%
:- pred tournament(psqueue(P, K)::in, psqueue(P, K)::in, psqueue(P, K)::out)
is det.
:- pragma type_spec(tournament/3, P = int).
tournament(PSQ0, PSQ1, PSQ) :-
PSQ = tournament(PSQ0, PSQ1).
:- func tournament(psqueue(P, K), psqueue(P, K)) = psqueue(P, K).
:- pragma type_spec(tournament/2, P = int).
tournament(PSQ1, PSQ2) = Res :-
(
PSQ1 = void,
Res = PSQ2
;
PSQ1 = winner(K1, Prio1, L1, MaxKey1),
(
PSQ2 = void,
Res = PSQ1
;
PSQ2 = winner(K2, Prio2, L2, MaxKey2),
( Prio1 `leq` Prio2 ->
% left wins
Res = winner(K1, Prio1,
balance(K2, Prio2, L1, MaxKey1, L2), MaxKey2)
;
% right wins
Res = winner(K2, Prio2,
balance(K1, Prio1, L1, MaxKey1, L2), MaxKey2)
)
)
).
:- func second_best(ltree(K, P), K) = psqueue(P, K) is det.
second_best(LTree, Key) = Res :-
(
LTree = start,
Res = void
;
LTree = loser(_, LK, LP, T, SplitKey, U),
( LK `leq` SplitKey ->
T1 = winner(LK, LP, T, SplitKey),
T2 = second_best(U, Key),
Res = tournament(T1, T2)
;
T1 = second_best(T, SplitKey),
T2 = winner(LK, LP, U, Key),
Res = tournament(T1, T2)
)
).
%---------------------------------------------------------------------------%
% create empty psqueue
%
init = PSQ :-
init(PSQ).
init(void).
% check for empty psqueue
%
is_empty(void).
singleton(P, K) = Res :-
singleton(P, K, Res).
singleton(P, K, PSQ) :-
PSQ = winner(K, P, start, K).
%-----------------------------------------------------------------------%
insert(P, K, !PSQ) :-
insert_tv(K, P, tournament_view(!.PSQ), !:PSQ).
det_insert(P, K, !PSQ) :-
( insert(P, K, !PSQ) ->
true
;
unexpected($file, $pred,
"error on inserting element into priority search queue")
).
det_insert(PSQ0, P, K) = PSQ :-
det_insert(P, K, PSQ0, PSQ).
:- pred insert_tv(K::in, P::in,
t_tournament_view(K, P)::in, psqueue(P, K)::out) is semidet.
insert_tv(IK, IP, TV, Res) :-
(
TV = emptySet,
Res = psqueue.singleton(IP, IK)
;
TV = singleton(Key, Prio),
compare(CMP, IK, Key),
(
CMP = (<),
Res = tournament(psqueue.singleton(IP, IK),
psqueue.singleton(Prio, Key))
;
CMP = (>),
Res = tournament(psqueue.singleton(Prio, Key),
psqueue.singleton(IP, IK))
)
;
TV = tournament_between(T1, T2),
T1 = winner(_, _, _, MaxKey1),
T2 = winner(_, _, _, _),
( IK `leq` MaxKey1 ->
insert(IP, IK, T1, Left),
Res = tournament(Left, T2)
;
insert(IP, IK, T2, Right),
Res = tournament(T1, Right)
)
).
%-----------------------------------------------------------------------%
peek(PSQ, MinPrio, MinKey) :-
PSQ = winner(MinKey, MinPrio, _, _).
det_peek(PSQ, MinPrio, MinKey) :-
( peek(PSQ, MinPrio0, MinKey0) ->
MinKey = MinKey0,
MinPrio = MinPrio0
;
unexpected($file, $pred, "priority search queue is empty")
).
remove_least(MinPrio, MinKey, PSQ, NewPSQ) :-
PSQ = winner(MinKey, MinPrio, L, MaxKey),
NewPSQ = second_best(L, MaxKey).
det_remove_least(MinPrio, MinKey, PSQ, NewPSQ) :-
( remove_least(MinPrio0, MinKey0, PSQ, NewPSQ0) ->
NewPSQ = NewPSQ0,
MinKey = MinKey0,
MinPrio = MinPrio0
;
unexpected($file, $pred, "priority search queue is empty")
).
%-----------------------------------------------------------------------%
to_assoc_list(PSQ) = Res :-
to_assoc_list(PSQ, Res).
to_assoc_list(PSQ, AList) :-
( remove_least(K, P, PSQ, PSQ0) ->
to_assoc_list(PSQ0, AList0),
AList = [K - P | AList0]
;
AList = []
).
from_assoc_list(AList) = Res :-
from_assoc_list(AList, Res).
from_assoc_list(AList, PSQ) :-
from_assoc_list2(AList, init, PSQ).
:- pred from_assoc_list2(assoc_list(P, K)::in, psqueue(P, K)::in,
psqueue(P, K)::out) is det.
from_assoc_list2([], !PSQ).
from_assoc_list2([(Prio - Key) | Rest], !PSQ) :-
det_insert(Prio, Key, !PSQ),
from_assoc_list2(Rest, !PSQ).
%-----------------------------------------------------------------------%
remove(P, K, !PSQ) :-
remove_tv(P, K, tournament_view(!.PSQ), !:PSQ).
det_remove(P, K, !PSQ) :-
( remove(PPrime, K, !.PSQ, PSQPrime) ->
P = PPrime,
!:PSQ = PSQPrime
;
unexpected($file, $pred, "element not found")
).
:- pred remove_tv(P::out, K::in,
t_tournament_view(K, P)::in, psqueue(P, K)::out) is semidet.
remove_tv(Prio, Key, TV, Res) :-
(
TV = emptySet,
false
;
TV = singleton(Key, Prio),
Res = void
;
TV = tournament_between(TL, TR),
TL = winner(_, _, _, MaxKey1),
( Key `leq` MaxKey1 ->
remove(Prio, Key, TL, Left),
Res = tournament(Left, TR)
;
remove(Prio, Key, TR, Right),
Res = tournament(TL, Right)
)
).
%---------------------------------------------------------------------------%
:- pred leq(V::in, V::in) is semidet.
:- pragma type_spec(leq/2, V = int).
leq(ValLeft, ValRight) :-
compare(CMP, ValLeft, ValRight),
( CMP = (<)
; CMP = (=)
).
%-----------------------------------------------------------------------%
adjust(F, K, !PSQ) :-
adjust_tv(F, K, tournament_view(!.PSQ), !:PSQ).
:- pred adjust_tv(func(P) = P, K, t_tournament_view(K, P), psqueue(P, K)).
:- mode adjust_tv(func(in) = out is det, in, in, out) is semidet.
adjust_tv(Func, K, TV, Res) :-
(
TV = emptySet,
false
;
TV = singleton(Key, Prio),
( K = Key ->
Res = psqueue.singleton(Func(Prio), Key)
;
Res = psqueue.singleton(Prio, Key)
)
;
TV = tournament_between(TL, TR),
TL = winner(_, _, _, MaxKey1),
( K `leq` MaxKey1 ->
adjust(Func, K, TL, Left),
Res = tournament(Left, TR)
;
adjust(Func, K, TR, Right),
Res = tournament(TL, Right)
)
).
%---------------------------------------------------------------------------%
search(PSQ, K, P) :-
search_tv(tournament_view(PSQ), K, P).
:- pred search_tv(t_tournament_view(K, P)::in, K::in, P::out) is semidet.
search_tv(TV, K, Res) :-
(
TV = singleton(Key, Prio),
Key = K,
Res = Prio
;
TV = tournament_between(TL, TR),
TL = winner(_, _, _, MaxKey1),
( K `leq` MaxKey1 ->
search(TL, K, Res)
;
search(TR, K, Res)
)
).
lookup(PSQ, K, P) :-
( search(PSQ, K, PPrime) ->
P = PPrime
;
unexpected($file, $pred, "element not found")
).
lookup(PSQ, K) = P :-
lookup(PSQ, K, P).
%-----------------------------------------------------------------------%
at_most(PSQ, P) = Res :-
at_most(PSQ, P, Res).
at_most(PSQ, Pt, AList) :-
MView = min_view(PSQ),
(
MView = empty,
AList = []
;
MView = min(_, Prio, _),
compare(CMP, Prio, Pt),
(
CMP = (>),
AList = []
;
( CMP = (=)
; CMP = (<)
),
TView = tournament_view(PSQ),
(
TView = emptySet,
AList = []
;
TView = singleton(Prio0, Key0),
AList = [Key0 - Prio0]
;
TView = tournament_between(T1, T2),
at_most(T1, Pt, AL0),
at_most(T2, Pt, AL1),
AList = AL0 ++ AL1
)
)
).
size(PSQ, Size) :-
(
PSQ = void,
Size = 0
;
PSQ = winner(_, _, LTree, _),
Size = ltree_size(LTree)
).
size(PSQ) = Res :-
size(PSQ, Res).
:- func ltree_size(ltree(K, P)) = t_ltree_size.
ltree_size(LTree) = Res :-
(
LTree = start, Res = 0
;
LTree = loser(Res, _, _, _, _, _)
).
%---------------------------------------------------------------------------%
% view types for min view, tournament view and tree view
%---------------------------------------------------------------------------%
:- type t_min_view(K, P)
---> empty
; min(K, P, psqueue(P, K)).
:- type t_tournament_view(K, P)
---> emptySet
; singleton(K, P)
; tournament_between(psqueue(P, K), psqueue(P, K)).
:- type t_tree_view(K, P)
---> leaf
; node(K, P, ltree(K, P), K, ltree(K, P)).
%---------------------------------------------------------------------------%
% get min view of priority search queue
%
:- func min_view(psqueue(P, K)) = t_min_view(K, P).
min_view(PSQ) = Res :-
(
PSQ = void,
Res = empty
;
PSQ = winner(Key, Prio, LTree, MaxKey),
Res = min(Key, Prio, second_best(LTree, MaxKey))
).
% get tournament view of priority search queue
%
:- func tournament_view(psqueue(P, K)) = t_tournament_view(K, P).
tournament_view(PSQ) = Res :-
(
PSQ = void,
Res = emptySet
;
PSQ = winner(K, P, LTree, MaxKey),
(
LTree = start,
Res = singleton(K, P)
;
LTree = loser(_, LK, LP, TL, SplitKey, TR),
( LK `leq` SplitKey ->
Res = tournament_between(winner(LK, LP, TL, SplitKey),
winner(K, P, TR, MaxKey))
;
Res = tournament_between(winner(K, P, TL, SplitKey),
winner(LK, LP, TR, MaxKey))
)
)
).
% get tree view of priority search queue
%
:- func tree_view(ltree(K, P)) = t_tree_view(K, P) is det.
tree_view(LTree) = Res :-
(
LTree = start,
Res = leaf
;
LTree = loser(_, LK, LP, LL, SplitKey, LR),
Res = node(LK, LP, LL, SplitKey, LR)
).
%---------------------------------------------------------------------------%
% smart constructors
%---------------------------------------------------------------------------%
:- func construct_leaf = ltree(K, P).
construct_leaf = start.
:- func construct_node(K, P, ltree(K, P), K, ltree(K, P)) = ltree(K, P).
construct_node(Key, Prio, L, SplitKey, R) = Res :-
Size = 1 + ltree_size(L) + ltree_size(R),
Res = loser(Size, Key, Prio, L, SplitKey, R).
%---------------------------------------------------------------------------%
% balancing functions for weight balanced trees
%---------------------------------------------------------------------------%
% balance factor, must be over 3.75 (see Ralf Hinze's paper)
%
:- func balance_omega = t_ltree_size.
balance_omega = 4.
:- func balance(K, P, ltree(K, P), K, ltree(K, P)) = ltree(K, P) is det.
:- func balance_left(K, P, ltree(K, P), K, ltree(K, P)) = ltree(K, P) is det.
:- func balance_right(K, P, ltree(K, P), K, ltree(K, P)) = ltree(K, P) is det.
:- func single_left(K, P, ltree(K, P), K, t_tree_view(K, P)) = ltree(K, P)
is det.
:- func single_right(K, P, t_tree_view(K, P), K, ltree(K, P)) = ltree(K, P)
is det.
:- func double_left(K, P, ltree(K, P), K, t_tree_view(K, P)) = ltree(K, P)
is det.
:- func double_right(K, P, t_tree_view(K, P), K, ltree(K, P)) = ltree(K, P)
is det.
balance(Key, Prio, L, SplitKey, R) = Res :-
SizeL = ltree_size(L),
SizeR = ltree_size(R),
( (SizeR + SizeL) < 2 ->
Res = construct_node(Key, Prio, L, SplitKey, R)
;
(( compare(CMP, SizeR, balance_omega * SizeL), CMP = (>)) ->
Res = balance_left(Key, Prio, L, SplitKey, R)
;
(( compare(CMP, SizeL, balance_omega * SizeR), CMP = (>)) ->
Res = balance_right(Key, Prio, L, SplitKey, R)
;
Res = construct_node(Key, Prio, L, SplitKey, R)
)
)
).
balance_left(Key, Prio, L, SplitKey, R) = Res :-
TVR = tree_view(R),
( TVR = node(_, _, RL, _, RR) ->
( (compare(CMP, ltree_size(RL), ltree_size(RR)), CMP = (<)) ->
Res = single_left(Key, Prio, L, SplitKey, TVR)
;
Res = double_left(Key, Prio, L, SplitKey, TVR)
)
;
unexpected($file, $pred, "error in left balance")
).
balance_right(Key, Prio, L, SplitKey, R) = Res :-
TVL = tree_view(L),
( TVL = node(_, _, LL, _, LR) ->
( (compare(CMP, ltree_size(LR), ltree_size(LL)), CMP = (<)) ->
Res = single_right(Key, Prio, TVL, SplitKey, R)
;
Res = double_right(Key, Prio, TVL, SplitKey, R)
)
;
unexpected($file, $pred, "error in right balance")
).
single_left(K1, P1, T1, S1, TVR) = Res :-
( TVR = node(K2, P2, T2, S2, T3) ->
( ( K2 `leq` S2, P1 `leq` P2 ) ->
Res = construct_node(K1, P1,
construct_node(K2, P2, T1, S1, T2), S2, T3)
;
Res = construct_node(K2, P2,
construct_node(K1, P1, T1, S1, T2), S2, T3)
)
;
unexpected($file, $pred, "error in single left rotation")
).
single_right(K1, P1, TVL, S2, T3) = Res :-
( TVL = node(K2, P2, T1, S1, T2) ->
( ( compare(CMP0, K2, S1), CMP0 = (>), P1 `leq` P2 ) ->
Res = construct_node(K1, P1, T1, S1,
construct_node(K2, P2, T2, S2, T3))
;
Res = construct_node(K2, P2, T1, S1,
construct_node(K1, P1, T2, S2, T3))
)
;
unexpected($file, $pred, "error in single right rotation")
).
double_left(K1, P1, T1, S1, TVR) = Res :-
( TVR = node(K2, P2, T2, S2, T3) ->
Res = single_left(K1, P1, T1, S1,
tree_view(single_right(K2, P2,
tree_view(T2), S2, T3)))
;
unexpected($file, $pred, "error in doulbe left rotation")
).
double_right(K1, P1, TVL, S2, T3) = Res :-
( TVL = node(K2, P2, T1, S1, T2) ->
Res = single_right(K1, P1,
tree_view(single_left(K2, P2, T1, S1,
tree_view(T2))),
S2, T3)
;
unexpected($file, $pred, "error in double right rotation")
).
%---------------------------------------------------------------------------%
% test predicates for correct implementation of psqueue
%---------------------------------------------------------------------------%
is_semi_heap(PSQ) :-
(
PSQ = void
;
PSQ = winner(_, Prio, LTree, _),
all_keys_larger_ltree(Prio, LTree),
all_nodes_loser_prio(LTree)
).
:- pred all_keys_larger_ltree(P::in, ltree(K, P)::in) is semidet.
all_keys_larger_ltree(Prio, LTree) :-
(
LTree = start
;
LTree = loser(_, _, LP, LT, _, RT),
Prio `leq` LP,
all_keys_larger_ltree(Prio, LT),
all_keys_larger_ltree(Prio, RT)
).
:- func min(V, V) = V is det.
min(P1, P2) = Res :-
( P1 `leq` P2 ->
Res = P1
;
Res = P2
).
:- func max(V, V) = V is det.
max(P1, P2) = Res :-
( P1 `leq` P2 ->
Res = P2
;
Res = P1
).
:- pred min_prio_loser_tree(ltree(K, P)::in, maybe(P)::out) is det.
min_prio_loser_tree(LTree, MinPrio) :-
(
LTree = start,
MinPrio = no
;
LTree = loser(_, _, Prio, TL, _, TR),
min_prio_loser_tree(TL, Prio, MinPrio1),
min_prio_loser_tree(TR, Prio, MinPrio2),
(
MinPrio1 = no,
MinPrio2 = no,
MinPrio = yes(Prio)
;
MinPrio1 = yes(MinPrio1Val),
MinPrio2 = no,
MinPrio = yes(min(MinPrio1Val, Prio))
;
MinPrio2 = yes(MinPrio2Val),
MinPrio1 = no,
MinPrio = yes(min(MinPrio2Val, Prio))
;
MinPrio1 = yes(MinPrio1Val),
MinPrio2 = yes(MinPrio2Val),
MinPrio = yes(min(MinPrio1Val,
min(Prio, MinPrio2Val)))
)
).
:- pred min_prio_loser_tree(ltree(K, P)::in, P::in, maybe(P)::out) is det.
min_prio_loser_tree(LTree, CurrMin, MinPrio) :-
(
LTree = start,
MinPrio = no
;
LTree = loser(_, _, Prio, TL, _, TR),
( CurrMin `leq` Prio ->
NewPrio = CurrMin
;
NewPrio = Prio
),
min_prio_loser_tree(TL, NewPrio, MinPrio1),
min_prio_loser_tree(TR, NewPrio, MinPrio2),
(
MinPrio1 = no,
MinPrio2 = no,
MinPrio = yes(NewPrio)
;
MinPrio1 = yes(MinPrio1Val),
MinPrio2 = no,
MinPrio = yes(min(MinPrio1Val, NewPrio))
;
MinPrio2 = yes(MinPrio2Val),
MinPrio1 = no,
MinPrio = yes(min(MinPrio2Val, NewPrio))
;
MinPrio1 = yes(MinPrio1Val),
MinPrio2 = yes(MinPrio2Val),
MinPrio = yes(min(MinPrio1Val,
min(MinPrio2Val, NewPrio)))
)
).
:- pred all_nodes_loser_prio(ltree(K, P)::in) is semidet.
all_nodes_loser_prio(LTree) :-
(
LTree = start
;
LTree = loser(_, K, Prio, TL, SplitKey, TR),
( K `leq` SplitKey ->
min_prio_loser_tree(TL, Prio, MinPrio)
;
min_prio_loser_tree(TR, Prio, MinPrio)
),
( MinPrio = no ->
MinPrio0 = Prio
;
MinPrio = yes(MinPrio0)
),
compare(CMP, Prio, MinPrio0),
CMP = (=),
all_nodes_loser_prio(TL),
all_nodes_loser_prio(TR)
).
%-----------------------------------------------------------------------%
is_search_tree(PSQ) :-
(
PSQ = void
;
PSQ = winner(_, _, LTree, _),
all_search_keys(LTree)
).
:- pred all_search_keys(ltree(K, P)::in) is semidet.
all_search_keys(LTree) :-
(
LTree = start
;
LTree = loser(_, _, _, TL, SplitKey, TR),
max_key_loser_tree(TL, MaxKeyL),
min_key_loser_tree(TR, MinKeyR),
(
MaxKeyL = no
;
MaxKeyL = yes(MaxKey),
MaxKey `leq` SplitKey,
all_search_keys(TL)
),
(
MinKeyR = no
;
MinKeyR = yes(MinKey),
compare(CMP, MinKey, SplitKey),
CMP = (>),
all_search_keys(TR)
)
).
:- pred min_key_loser_tree(ltree(K, P)::in, maybe(K)::out) is det.
min_key_loser_tree(LTree, MinKey) :-
(
LTree = start,
MinKey = no
;
LTree = loser(_, Key, _, TL, _, TR),
min_key_loser_tree(TL, Key, MinKey1),
min_key_loser_tree(TR, Key, MinKey2),
(
MinKey1 = no,
MinKey2 = no,
MinKey = yes(Key)
;
MinKey1 = yes(MinKey1Val),
MinKey2 = no,
MinKey = yes(min(MinKey1Val, Key))
;
MinKey2 = yes(MinKey2Val),
MinKey1 = no,
MinKey = yes(min(MinKey2Val, Key))
;
MinKey1 = yes(MinKey1Val),
MinKey2 = yes(MinKey2Val),
MinKey = yes(min(MinKey1Val,
min(Key, MinKey2Val)))
)
).
:- pred min_key_loser_tree(ltree(K, P)::in, K::in, maybe(K)::out) is det.
min_key_loser_tree(LTree, CurrMin, MinKey) :-
(
LTree = start, MinKey = no
;
LTree = loser(_, Key, _, TL, _, TR),
( CurrMin `leq` Key ->
NewKey = CurrMin
;
NewKey = Key
),
min_key_loser_tree(TL, NewKey, MinKey1),
min_key_loser_tree(TR, NewKey, MinKey2),
(
MinKey1 = no,
MinKey2 = no,
MinKey = yes(NewKey)
;
MinKey1 = yes(MinKey1Val),
MinKey2 = no,
MinKey = yes(min(MinKey1Val, NewKey))
;
MinKey2 = yes(MinKey2Val),
MinKey1 = no,
MinKey = yes(min(MinKey2Val, NewKey))
;
MinKey1 = yes(MinKey1Val),
MinKey2 = yes(MinKey2Val),
MinKey = yes(min(MinKey1Val,
min(MinKey2Val, NewKey)))
)
).
:- pred max_key_loser_tree(ltree(K, P)::in, maybe(K)::out) is det.
max_key_loser_tree(LTree, MaxKey) :-
(
LTree = start,
MaxKey = no
;
LTree = loser(_, Key, _, TL, _, TR),
max_key_loser_tree(TL, Key, MaxKey1),
max_key_loser_tree(TR, Key, MaxKey2),
(
MaxKey1 = no,
MaxKey2 = no,
MaxKey = yes(Key)
;
MaxKey1 = yes(MaxKey1Val),
MaxKey2 = no,
MaxKey = yes(max(MaxKey1Val, Key))
;
MaxKey2 = yes(MaxKey2Val),
MaxKey1 = no,
MaxKey = yes(max(MaxKey2Val, Key))
;
MaxKey1 = yes(MaxKey1Val),
MaxKey2 = yes(MaxKey2Val),
MaxKey = yes(max(MaxKey1Val,
max(Key, MaxKey2Val)))
)
).
:- pred max_key_loser_tree(ltree(K, P)::in, K::in, maybe(K)::out) is det.
max_key_loser_tree(LTree, CurrMax, MaxKey) :-
(
LTree = start, MaxKey = no
;
LTree = loser(_, Key, _, TL, _, TR),
compare(CMP, CurrMax, Key),
(
( CMP = (=)
; CMP = (>)
),
NewKey = CurrMax
;
CMP = (<),
NewKey = Key
),
max_key_loser_tree(TL, NewKey, MaxKey1),
max_key_loser_tree(TR, NewKey, MaxKey2),
(
MaxKey1 = no,
MaxKey2 = no,
MaxKey = yes(NewKey)
;
MaxKey1 = yes(MaxKey1Val),
MaxKey2 = no,
MaxKey = yes(max(MaxKey1Val, NewKey))
;
MaxKey2 = yes(MaxKey2Val),
MaxKey1 = no,
MaxKey = yes(max(MaxKey2Val, NewKey))
;
MaxKey1 = yes(MaxKey1Val),
MaxKey2 = yes(MaxKey2Val),
MaxKey = yes(max(MaxKey1Val,
max(MaxKey2Val, NewKey)))
)
).
%-----------------------------------------------------------------------%
key_condition(PSQ) :-
(
PSQ = void
;
PSQ = winner(_, _, T, MaxKey),
search(PSQ, MaxKey, _),
key_condition(PSQ, T)
).
:- pred key_condition(psqueue(P, K)::in, ltree(K, P)::in) is semidet.
key_condition(PSQ, T) :-
(
T = start
;
T = loser(_, _, _, TL, SplitKey, TR),
search(PSQ, SplitKey, _),
key_condition(PSQ, TL),
key_condition(PSQ, TR)
).
%-----------------------------------------------------------------------%
is_finite_map(PSQ) :-
(
PSQ = void
;
PSQ = winner(_, _, T, _),
KeyList = get_keys(T),
UniqList = list.sort_and_remove_dups(KeyList),
length(KeyList, LK),
length(UniqList, LUK),
LK = LUK
).
:- func get_keys(ltree(K, P)) = list(K).
get_keys(T) = Res :-
(
T = start,
Res = []
;
T = loser(_, K, _, TL, _, TR),
Res = [K | get_keys(TL) ++ get_keys(TR)]
).
%---------------------------------------------------------------------------%
:- end_module psqueue.
%---------------------------------------------------------------------------%
More information about the reviews
mailing list