e5f4633c39
which included commits to RCS files with non-trunk default branches. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
283 lines
5.9 KiB
Prolog
283 lines
5.9 KiB
Prolog
% Thom Fruehwirth ECRC 1991-1993
|
|
% 910528 started boolean,and,or constraints
|
|
% 910904 added xor,neg constraints
|
|
% 911120 added imp constraint
|
|
% 931110 ported to new release
|
|
% 931111 added card constraint
|
|
% 961107 Christian Holzbaur, SICStus mods
|
|
|
|
:- use_module( library(chr)).
|
|
|
|
handler bool.
|
|
|
|
constraints boolean/1, and/3, or/3, xor/3, neg/2, imp/2.
|
|
constraints labeling/0.
|
|
|
|
|
|
boolean(0) <=> true.
|
|
boolean(1) <=> true.
|
|
|
|
labeling, boolean(A)#Pc <=>
|
|
(A=0 ; A=1),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
|
|
% and/3 specification
|
|
%and(0,0,0).
|
|
%and(0,1,0).
|
|
%and(1,0,0).
|
|
%and(1,1,1).
|
|
|
|
and(0,X,Y) <=> Y=0.
|
|
and(X,0,Y) <=> Y=0.
|
|
and(1,X,Y) <=> Y=X.
|
|
and(X,1,Y) <=> Y=X.
|
|
and(X,Y,1) <=> X=1,Y=1.
|
|
and(X,X,Z) <=> X=Z.
|
|
%and(X,Y,X) <=> imp(X,Y).
|
|
%and(X,Y,Y) <=> imp(Y,X).
|
|
and(X,Y,A) \ and(X,Y,B) <=> A=B.
|
|
and(X,Y,A) \ and(Y,X,B) <=> A=B.
|
|
|
|
labeling, and(A,B,C)#Pc <=>
|
|
label_and(A,B,C),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
label_and(0,X,0).
|
|
label_and(1,X,X).
|
|
|
|
|
|
% or/3 specification
|
|
%or(0,0,0).
|
|
%or(0,1,1).
|
|
%or(1,0,1).
|
|
%or(1,1,1).
|
|
|
|
or(0,X,Y) <=> Y=X.
|
|
or(X,0,Y) <=> Y=X.
|
|
or(X,Y,0) <=> X=0,Y=0.
|
|
or(1,X,Y) <=> Y=1.
|
|
or(X,1,Y) <=> Y=1.
|
|
or(X,X,Z) <=> X=Z.
|
|
%or(X,Y,X) <=> imp(Y,X).
|
|
%or(X,Y,Y) <=> imp(X,Y).
|
|
or(X,Y,A) \ or(X,Y,B) <=> A=B.
|
|
or(X,Y,A) \ or(Y,X,B) <=> A=B.
|
|
|
|
labeling, or(A,B,C)#Pc <=>
|
|
label_or(A,B,C),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
label_or(0,X,X).
|
|
label_or(1,X,1).
|
|
|
|
|
|
% xor/3 specification
|
|
%xor(0,0,0).
|
|
%xor(0,1,1).
|
|
%xor(1,0,1).
|
|
%xor(1,1,0).
|
|
|
|
xor(0,X,Y) <=> X=Y.
|
|
xor(X,0,Y) <=> X=Y.
|
|
xor(X,Y,0) <=> X=Y.
|
|
xor(1,X,Y) <=> neg(X,Y).
|
|
xor(X,1,Y) <=> neg(X,Y).
|
|
xor(X,Y,1) <=> neg(X,Y).
|
|
xor(X,X,Y) <=> Y=0.
|
|
xor(X,Y,X) <=> Y=0.
|
|
xor(Y,X,X) <=> Y=0.
|
|
xor(X,Y,A) \ xor(X,Y,B) <=> A=B.
|
|
xor(X,Y,A) \ xor(Y,X,B) <=> A=B.
|
|
|
|
labeling, xor(A,B,C)#Pc <=>
|
|
label_xor(A,B,C),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
label_xor(0,X,X).
|
|
label_xor(1,X,Y):- neg(X,Y).
|
|
|
|
|
|
% neg/2 specification
|
|
%neg(0,1).
|
|
%neg(1,0).
|
|
|
|
neg(0,X) <=> X=1.
|
|
neg(X,0) <=> X=1.
|
|
neg(1,X) <=> X=0.
|
|
neg(X,1) <=> X=0.
|
|
neg(X,X) <=> fail.
|
|
neg(X,Y) \ neg(Y,Z) <=> X=Z.
|
|
neg(X,Y) \ neg(Z,Y) <=> X=Z.
|
|
neg(Y,X) \ neg(Y,Z) <=> X=Z.
|
|
% Interaction with other boolean constraints
|
|
neg(X,Y) \ and(X,Y,Z) <=> Z=0.
|
|
neg(Y,X) \ and(X,Y,Z) <=> Z=0.
|
|
neg(X,Z) , and(X,Y,Z) <=> X=1,Y=0,Z=0.
|
|
neg(Z,X) , and(X,Y,Z) <=> X=1,Y=0,Z=0.
|
|
neg(Y,Z) , and(X,Y,Z) <=> X=0,Y=1,Z=0.
|
|
neg(Z,Y) , and(X,Y,Z) <=> X=0,Y=1,Z=0.
|
|
neg(X,Y) \ or(X,Y,Z) <=> Z=1.
|
|
neg(Y,X) \ or(X,Y,Z) <=> Z=1.
|
|
neg(X,Z) , or(X,Y,Z) <=> X=0,Y=1,Z=1.
|
|
neg(Z,X) , or(X,Y,Z) <=> X=0,Y=1,Z=1.
|
|
neg(Y,Z) , or(X,Y,Z) <=> X=1,Y=0,Z=1.
|
|
neg(Z,Y) , or(X,Y,Z) <=> X=1,Y=0,Z=1.
|
|
neg(X,Y) \ xor(X,Y,Z) <=> Z=1.
|
|
neg(Y,X) \ xor(X,Y,Z) <=> Z=1.
|
|
neg(X,Z) \ xor(X,Y,Z) <=> Y=1.
|
|
neg(Z,X) \ xor(X,Y,Z) <=> Y=1.
|
|
neg(Y,Z) \ xor(X,Y,Z) <=> X=1.
|
|
neg(Z,Y) \ xor(X,Y,Z) <=> X=1.
|
|
neg(X,Y) , imp(X,Y) <=> X=0,Y=1.
|
|
neg(Y,X) , imp(X,Y) <=> X=0,Y=1.
|
|
|
|
labeling, neg(A,B)#Pc <=>
|
|
label_neg(A,B),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
label_neg(0,1).
|
|
label_neg(1,0).
|
|
|
|
|
|
% imp/2 specification (implication)
|
|
%imp(0,0).
|
|
%imp(0,1).
|
|
%imp(1,1).
|
|
|
|
imp(0,X) <=> true.
|
|
imp(X,0) <=> X=0.
|
|
imp(1,X) <=> X=1.
|
|
imp(X,1) <=> true.
|
|
imp(X,X) <=> true.
|
|
imp(X,Y),imp(Y,X) <=> X=Y.
|
|
|
|
labeling, imp(A,B)#Pc <=>
|
|
label_imp(A,B),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
label_imp(0,X).
|
|
label_imp(1,1).
|
|
|
|
|
|
|
|
% Boolean cardinality operator
|
|
% card(A,B,L,N) constrains list L of length N to have between A and B 1s
|
|
|
|
constraints card/4.
|
|
|
|
card(A,B,L):-
|
|
length(L,N),
|
|
A=<B,0=<B,A=<N,%0=<N
|
|
card(A,B,L,N).
|
|
|
|
% card/4 specification
|
|
%card(A,B,[],0):- A=<0,0=<B.
|
|
%card(A,B,[0|L],N):-
|
|
% N1 is N-1,
|
|
% card(A,B,L,N1).
|
|
%card(A,B,[1|L],N):-
|
|
% A1 is A-1, B1 is B-1, N1 is N-1,
|
|
% card(A1,B1,L,N1).
|
|
|
|
triv_sat @ card(A,B,L,N) <=> A=<0,N=<B | true. % trivial satisfaction
|
|
pos_sat @ card(N,B,L,N) <=> set_to_ones(L). % positive satisfaction
|
|
neg_sat @ card(A,0,L,N) <=> set_to_zeros(L). % negative satisfaction
|
|
pos_red @ card(A,B,L,N) <=> delete(X,L,L1),X==1 | % positive reduction
|
|
A1 is A-1, B1 is B-1, N1 is N-1,
|
|
card(A1,B1,L1,N1).
|
|
neg_red @ card(A,B,L,N) <=> delete(X,L,L1),X==0 | % negative reduction
|
|
N1 is N-1,
|
|
card(A,B,L1,N1).
|
|
% special cases with two variables
|
|
card2nand @ card(0,1,[X,Y],2) <=> and(X,Y,0).
|
|
card2neg @ card(1,1,[X,Y],2) <=> neg(X,Y).
|
|
card2or @ card(1,2,[X,Y],2) <=> or(X,Y,1).
|
|
|
|
delete( X, [X|L], L).
|
|
delete( Y, [X|Xs], [X|Xt]) :-
|
|
delete( Y, Xs, Xt).
|
|
|
|
labeling, card(A,B,L,N)#Pc <=>
|
|
label_card(A,B,L,N),
|
|
labeling
|
|
pragma passive(Pc).
|
|
|
|
label_card(A,B,[],0):- A=<0,0=<B.
|
|
label_card(A,B,[0|L],N):-
|
|
N1 is N-1,
|
|
card(A,B,L).
|
|
label_card(A,B,[1|L],N):-
|
|
A1 is A-1, B1 is B-1, N1 is N-1,
|
|
card(A1,B1,L).
|
|
|
|
set_to_ones([]).
|
|
set_to_ones([1|L]):-
|
|
set_to_ones(L).
|
|
|
|
set_to_zeros([]).
|
|
set_to_zeros([0|L]):-
|
|
set_to_zeros(L).
|
|
|
|
|
|
|
|
% Auxiliary predicates
|
|
|
|
operator(100,fy,(~~)).
|
|
operator(100,xfy,(#)).
|
|
|
|
solve_bool(A,C) :- var(A), !, A=C.
|
|
solve_bool(A,C) :- atomic(A), !, A=C.
|
|
solve_bool(A * B, C) ?- !,
|
|
solve_bool(A,A1),
|
|
solve_bool(B,B1),
|
|
and(A1,B1,C).
|
|
solve_bool(A + B, C) ?- !,
|
|
solve_bool(A,A1),
|
|
solve_bool(B,B1),
|
|
or(A1,B1,C).
|
|
solve_bool(A # B, C) ?- !,
|
|
solve_bool(A,A1),
|
|
solve_bool(B,B1),
|
|
xor(A1,B1,C).
|
|
solve_bool(~~A,C) ?- !,
|
|
solve_bool(A,A1),
|
|
neg(A1,C).
|
|
solve_bool((A -> B), C) ?- !,
|
|
solve_bool(A,A1),
|
|
solve_bool(B,B1),
|
|
imp(A1,B1),C=1.
|
|
solve_bool(A = B, C) ?- !,
|
|
solve_bool(A,A1),
|
|
solve_bool(B,B1),
|
|
A1=B1,C=1.
|
|
|
|
% Labeling
|
|
label_bool([]).
|
|
label_bool([X|L]) :-
|
|
(X=0;X=1),
|
|
label_bool(L).
|
|
|
|
/* % no write macros in SICStus
|
|
|
|
bool_portray(and(A,B,C),Out)?- !, Out = (A*B = C).
|
|
bool_portray(or(A,B,C),Out)?- !, Out = (A+B = C).
|
|
bool_portray(xor(A,B,C),Out)?- !, Out = (A#B = C).
|
|
bool_portray(neg(A,B),Out)?- !, Out = (A= ~~B).
|
|
bool_portray(imp(A,B),Out)?- !, Out = (A -> B).
|
|
bool_portray(card(A,B,L,N),Out)?- !, Out = card(A,B,L).
|
|
|
|
:- define_macro(type(compound),bool_portray/2,[write]).
|
|
*/
|
|
|
|
/* end of handler bool */
|
|
|
|
|
|
|