pereira@sri-unix.UUCP (08/22/83)
/* BAGUTL.PL Bag Utilities
R.A.O'Keefe. Updated: 10 Sept 81
A bag B is a function from a set dom(B) to the non-negative integers.
For the purposes of this module, a bag is constructed from two functions:
bag - creates an empty bag
bag(E, M, B) - extends the bag B with a new (NB!) element E
which occurs with multiplicity M, and which
precedes all elements of B in Prolog's order.
A bag is represented by a Prolog term mirroring its construction. There
is one snag with this: what are we to make of
bag(f(a,Y), 1, bag(f(X,b), 1, bag)) ?
As a term it has two distinct elements, but f(a,b) will be reported as
occurring in it twice. But according to the definition above,
bag(f(a,b), 1, bag(f(a,b), 1, bag))
is not the representation of any bag, that bag is represented by
bag(f(a,b), 2, bag)
alone. We are apparently stuck with a scheme which is only guaranteed
to work for ground terms.
The reason for insisting on the order is to make union and
intersection linear in the sizes of their arguments.
*/
:- public is_bag/1.
:- mode is_bag(+), is_bag(+, +), posint(+).
is_bag(bag(E, M, B)) :-
posint(M),
is_bag(B, E).
is_bag(bag).
is_bag(bag(E, M, B), P) :-
E @> P,
posint(M),
is_bag(B, E).
is_bag(bag, P).
posint(M) :-
integer(M),
M > 0.
:- public portray_bag/1.
:- mode portray_bag(+), pbag(+, +, +), pbag(+, +).
portray_bag(bag(E,M,B)) :-
write('[% '), pbag(E, M, B), write(' %]').
portray_bag(bag) :-
write('[% '), write(' %]').
pbag(E, M, B) :-
var(B), !,
pbag(E, M), write(' | '), write(B).
pbag(E, M, bag(F, N, B)) :- !,
pbag(E, M), write(', '), pbag(F, N, B).
pbag(E, M, bag) :- !,
pbag(E, M).
pbag(E, M, B) :-
pbag(E, M), write(' | '), write(B).
pbag(E, M) :-
print(E), write(':'), write(M).
% If bags are to be as useful as lists, we should provide mapping
% predicates similar to those for lists. Hence
% checkbag(Pred, Bag) - applies Pred(Element, Count)
% mapbag(Pred, BagIn, BagOut) - applies Pred(Element, Answer)
% Note that mapbag does NOT give the Count to Pred, but preserves it.
% It wouldn't be hard to apply Pred to four arguments if it wants them.
:- public checkbag/2, mapbag/3.
:- mode checkbag(+, +), mapbag(+, +, -), mapbaglist(+, +, -).
checkbag(Pred, bag(E, M, B)) :-
apply(Pred, [E, M]),
checkbag(Pred, B).
checkbag(Pred, bag).
mapbag(Pred, BagIn, BagOut) :-
mapbaglist(Pred, BagIn, Listed),
keysort(Listed, Sorted),
bagform(Sorted, BagOut).
mapbaglist(Pred, bag(E, M, B), [R-M|L]) :-
apply(Pred, [E, R]),
mapbaglist(Pred, B, L).
mapbaglist(Pred, bag, []).
:- public bag_to_list/2.
:- mode bag_to_list(+, -), bag_to_list(+, +, -, -).
bag_to_list(bag(E, M, B), R) :-
bag_to_list(M, E, L, R),
bag_to_list(B, L).
bag_to_list(bag, []).
bag_to_list(0, E, L, L) :- !.
bag_to_list(M, E, L, [E|R]) :-
N is M-1,
bag_to_list(N, E, L, R).
:- public list_to_bag/2.
:- mode list_to_bag(+, -), bagform(+, -), bagform(?, +, -, +, -).
:- mode addkeys(+, -). % hack to circumvent 'sort' nastiness
list_to_bag(L, B) :-
addkeys(L, K),
keysort(K, S),
bagform(S, B).
addkeys([Head|Tail], [Head-1|Rest]) :-
addkeys(Tail, Rest).
addkeys([], []).
bagform([], bag) :- !.
bagform(List, bag(E, M, B)) :-
bagform(E, List, Rest, 0, M), !,
bagform(Rest, B).
bagform(Head, [Head-N|Tail], Rest, K, M) :-!,
L is K+N,
bagform(Head, Tail, Rest, L, M).
bagform(Head, Rest, Rest, M, M).
:- public bag_to_set/2.
:- mode bag_to_set(+, -).
bag_to_set(bag(E, M, B), [E|S]) :-
bag_to_set(B, S).
bag_to_set(bag, []).
/* There are two versions of the routines member, bagmax, and bagmin.
The slow versions, which are commented out, try to allow for the
possibility that distinct elements in the bag might unify, while
the faster routines assume that all elements are ground terms.
:- public member/3.
:- mode member(?, -, +), member(+, +, +, -).
member(E, M, bag(E, K, B)) :-
member(B, E, K, M).
member(E, M, bag(_, _, B)) :-
member(E, M, B).
member(bag(E, L, B), E, K, M) :- !,
N is K+L,
member(B, E, N, M).
member(bag(_, _, B), E, K, M) :-
member(B, E, K, M).
member(bag, E, M, M).
:- public bagmax/2, bagmin/2.
:- mode bagmax(+, ?), bagmin(+, ?).
% These routines are correct, but Oh, so costly!
bagmax(B, E) :-
member(E, M, B),
\+ (member(F, N, B), N > M).
bagmin(B, E) :-
member(E, M, B),
\+ (member(F, N, B), N < M).
*//* The faster versions follow */
:- public member/3.
:- mode member(?, ?, +).
member(Element, Multiplicity, bag(Element, Multiplicity, _)).
member(Element, Multiplicity, bag(_, _, Bag)) :-
member(Element, Multiplicity, Bag).
:- public bagmax/2, bagmin/2.
:- mode bagmax(+, -), bagmin(+, -), bag_scan(+, +, +, -, +).
bagmax(bag(E, M, B), Emax) :-
bag_scan(B, E, M, Emax, >).
bagmin(bag(E, M, B), Emin) :-
bag_scan(B, E, M, Emin, <).
bag_scan(bag(Eb,Mb,B), Ei, Mi, Eo, C) :-
compare(C, Mb, Mi), !,
bag_scan(B, Eb, Mb, Eo, C).
bag_scan(bag(Eb,Mb,B), Ei, Mi, Eo, C) :-
bag_scan(B, Ei, Mi, Eo, C).
/* bag_scan(bag(Eb,Mb,B), Ei, Mi, Eo, C) :-
bag_scan(B, Eb, Mb, Eo, C). % for all extrema
*/ bag_scan(bag, Ei, Mi, Ei, C).
:- public length/3.
:- mode length(+, -, -), length(+, +, -, +, -).
length(B, BL, SL) :-
length(B, 0, BL, 0, SL).
length(bag(_,M,B), BA, BL, SA, SL) :-
BB is BA+M, SB is SA+1,
length(B, BB, BL, SB, SL).
length(bag, BL, BL, SL, SL).
% sub_bag, if it existed, could be used two ways: to test whether one bag
% is a sub_bag of another, or to generate all the sub_bags. The two uses
% need different implementations.
:- public make_sub_bag/2.
:- mode make_sub_bag(+, -), countdown(+, -).
make_sub_bag(bag(E, M, B), bag(E, N, C)) :-
countdown(M, N),
make_sub_bag(B, C).
make_sub_bag(bag(E, M, B), C) :-
make_sub_bag(B, C).
make_sub_bag(bag, bag).
countdown(M, M).
countdown(M, N) :-
M > 1, K is M-1,
countdown(K, N).
:- public test_sub_bag/2.
:- mode test_sub_bag(+, +), test_sub_bag(+, +, +, +, +, +, +).
test_sub_bag(bag(E1, M1, B1), bag(E2, M2, B2)) :-
compare(C, E1, E2),
test_sub_bag(C, E1, M1, B1, E2, M2, B2).
test_sub_bag(bag, Bag).
test_sub_bag(>, E1, M1, B1, E2, M2, B2) :-
test_sub_bag(bag(E1, M1, B1), B2).
test_sub_bag(=, E1, M1, B1, E1, M2, B2) :-
M1 =< M2,
test_sub_bag(B1, B2).
:- public bag_union/3.
:- mode bag_union(+, +, -), bag_union(+, +, +, +, +, +, +, -).
bag_union(bag(E1, M1, B1), bag(E2, M2, B2), B3) :-
compare(C, E1, E2), !,
bag_union(C, E1, M1, B1, E2, M2, B2, B3).
bag_union(bag, Bag, Bag) :- !.
bag_union(Bag, bag, Bag).
bag_union(<, E1, M1, B1, E2, M2, B2, bag(E1, M1, B3)) :-
bag_union(B1, bag(E2, M2, B2), B3).
bag_union(>, E1, M1, B1, E2, M2, B2, bag(E2, M2, B3)) :-
bag_union(bag(E1, M1, B1), B2, B3).
bag_union(=, E1, M1, B1, E1, M2, B2, bag(E1, M3, B3)) :-
M3 is M1+M2,
bag_union(B1, B2, B3).
:- public bag_inter/3.
:- mode bag_inter(+, +, -), bag_inter(+, +, +, +, +, +, +, -).
bag_inter(bag(E1, M1, B1), bag(E2, M2, B2), B3) :-
compare(C, E1, E2), !,
bag_inter(C, E1, M1, B1, E2, M2, B2, B3).
bag_inter(B1, B2, bag).
bag_inter(<, E1, M1, B1, E2, M2, B2, B3) :-
bag_inter(B1, bag(E2, M2, B2), B3).
bag_inter(>, E1, M1, B1, E2, M2, B2, B3) :-
bag_inter(bag(E1, M1, B1), B2, B3).
bag_inter(=, E1, M1, B1, E1, M2, B2, bag(E1, M3, B3)) :-
( M1 < M2, M3 = M1 ; M3 = M2 ), !,
bag_inter(B1, B2, B3).
/* Sorted list of Bag Utilities:
bag_inter(+Bag1, +Bag2, -Inter)
bag_to_list(+Bag, -List)
bag_to_set(+Bag, -SetList)
bag_union(+Bag1, +Bag2, -Union)
bagmax(+Bag, ?Elem)
bagmin(+Bag, ?Elem)
checkbag(+Pred, +Bag)
is_bag(+Bag)
length(+Bag, -Total, -Distinct)
list_to_bag(+List, -Bag)
make_sub_bag(+Bag, -SubBag)
mapbag(+Pred, +BagIn, -BagOut)
member(?Elem, -Count, +Bag)
portray_bag(+Bag)
test_sub_bag(+SubBag, +Bag)
End of List */