Examples/bool.chr

   1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   2 %%
   3 %% Thom Fruehwirth ECRC 1991-1993
   4 %% 910528 started boolean,and,or constraints
   5 %% 910904 added xor,neg constraints
   6 %% 911120 added imp constraint
   7 %% 931110 ported to new release
   8 %% 931111 added card constraint
   9 %% 961107 Christian Holzbaur, SICStus mods
  10 %%
  11 %% ported to hProlog by Tom Schrijvers June 2003
  12
  13
  14 :- module(bool,[]).
  15 :- use_module(library(chr)).
  16
  17 :- constraints boolean/1, and/3, or/3, xor/3, neg/2, imp/2, labeling/0, card/4.
  18
  19
  20 boolean(0) <=> true.
  21 boolean(1) <=> true.
  22
  23 labeling, boolean(A)#Pc <=>
  24 ( A=0 ; A=1),
  25 labeling
  26 pragma passive(Pc).
  27
  28
  29 %% and/3 specification
  30 %%and(0,0,0).
  31 %%and(0,1,0).
  32 %%and(1,0,0).
  33 %%and(1,1,1).
  34
  35 and(0,X,Y) <=> Y=0.
  36 and(X,0,Y) <=> Y=0.
  37 and(1,X,Y) <=> Y=X.
  38 and(X,1,Y) <=> Y=X.
  39 and(X,Y,1) <=> X=1,Y=1.
  40 and(X,X,Z) <=> X=Z.
  41 %%and(X,Y,X) <=> imp(X,Y).
  42 %%and(X,Y,Y) <=> imp(Y,X).
  43 and(X,Y,A) \ and(X,Y,B) <=> A=B.
  44 and(X,Y,A) \ and(Y,X,B) <=> A=B.
  45
  46 labeling, and(A,B,C)#Pc <=>
  47 label_and(A,B,C),
  48 labeling
  49 pragma passive(Pc).
  50
  51 label_and(0,X,0).
  52 label_and(1,X,X).
  53
  54
  55 %% or/3 specification
  56 %%or(0,0,0).
  57 %%or(0,1,1).
  58 %%or(1,0,1).
  59 %%or(1,1,1).
  60
  61 or(0,X,Y) <=> Y=X.
  62 or(X,0,Y) <=> Y=X.
  63 or(X,Y,0) <=> X=0,Y=0.
  64 or(1,X,Y) <=> Y=1.
  65 or(X,1,Y) <=> Y=1.
  66 or(X,X,Z) <=> X=Z.
  67 %%or(X,Y,X) <=> imp(Y,X).
  68 %%or(X,Y,Y) <=> imp(X,Y).
  69 or(X,Y,A) \ or(X,Y,B) <=> A=B.
  70 or(X,Y,A) \ or(Y,X,B) <=> A=B.
  71
  72 labeling, or(A,B,C)#Pc <=>
  73 label_or(A,B,C),
  74 labeling
  75 pragma passive(Pc).
  76
  77 label_or(0,X,X).
  78 label_or(1,X,1).
  79
  80
  81 %% xor/3 specification
  82 %%xor(0,0,0).
  83 %%xor(0,1,1).
  84 %%xor(1,0,1).
  85 %%xor(1,1,0).
  86
  87 xor(0,X,Y) <=> X=Y.
  88 xor(X,0,Y) <=> X=Y.
  89 xor(X,Y,0) <=> X=Y.
  90 xor(1,X,Y) <=> neg(X,Y).
  91 xor(X,1,Y) <=> neg(X,Y).
  92 xor(X,Y,1) <=> neg(X,Y).
  93 xor(X,X,Y) <=> Y=0.
  94 xor(X,Y,X) <=> Y=0.
  95 xor(Y,X,X) <=> Y=0.
  96 xor(X,Y,A) \ xor(X,Y,B) <=> A=B.
  97 xor(X,Y,A) \ xor(Y,X,B) <=> A=B.
  98
  99 labeling, xor(A,B,C)#Pc <=>
 100 label_xor(A,B,C),
 101 labeling
 102 pragma passive(Pc).
 103
 104 label_xor(0,X,X).
 105 label_xor(1,X,Y):- neg(X,Y).
 106
 107
 108 %% neg/2 specification
 109 %%neg(0,1).
 110 %%neg(1,0).
 111
 112 neg(0,X) <=> X=1.
 113 neg(X,0) <=> X=1.
 114 neg(1,X) <=> X=0.
 115 neg(X,1) <=> X=0.
 116 neg(X,X) <=> fail.
 117 neg(X,Y) \ neg(Y,Z) <=> X=Z.
 118 neg(X,Y) \ neg(Z,Y) <=> X=Z.
 119 neg(Y,X) \ neg(Y,Z) <=> X=Z.
 120 %% Interaction with other boolean constraints
 121 neg(X,Y) \ and(X,Y,Z) <=> Z=0.
 122 neg(Y,X) \ and(X,Y,Z) <=> Z=0.
 123 neg(X,Z) , and(X,Y,Z) <=> X=1,Y=0,Z=0.
 124 neg(Z,X) , and(X,Y,Z) <=> X=1,Y=0,Z=0.
 125 neg(Y,Z) , and(X,Y,Z) <=> X=0,Y=1,Z=0.
 126 neg(Z,Y) , and(X,Y,Z) <=> X=0,Y=1,Z=0.
 127 neg(X,Y) \ or(X,Y,Z) <=> Z=1.
 128 neg(Y,X) \ or(X,Y,Z) <=> Z=1.
 129 neg(X,Z) , or(X,Y,Z) <=> X=0,Y=1,Z=1.
 130 neg(Z,X) , or(X,Y,Z) <=> X=0,Y=1,Z=1.
 131 neg(Y,Z) , or(X,Y,Z) <=> X=1,Y=0,Z=1.
 132 neg(Z,Y) , or(X,Y,Z) <=> X=1,Y=0,Z=1.
 133 neg(X,Y) \ xor(X,Y,Z) <=> Z=1.
 134 neg(Y,X) \ xor(X,Y,Z) <=> Z=1.
 135 neg(X,Z) \ xor(X,Y,Z) <=> Y=1.
 136 neg(Z,X) \ xor(X,Y,Z) <=> Y=1.
 137 neg(Y,Z) \ xor(X,Y,Z) <=> X=1.
 138 neg(Z,Y) \ xor(X,Y,Z) <=> X=1.
 139 neg(X,Y) , imp(X,Y) <=> X=0,Y=1.
 140 neg(Y,X) , imp(X,Y) <=> X=0,Y=1.
 141
 142 labeling, neg(A,B)#Pc <=>
 143 label_neg(A,B),
 144 labeling
 145 pragma passive(Pc).
 146
 147 label_neg(0,1).
 148 label_neg(1,0).
 149
 150
 151 %% imp/2 specification (implication)
 152 %%imp(0,0).
 153 %%imp(0,1).
 154 %%imp(1,1).
 155
 156 imp(0,X) <=> true.
 157 imp(X,0) <=> X=0.
 158 imp(1,X) <=> X=1.
 159 imp(X,1) <=> true.
 160 imp(X,X) <=> true.
 161 imp(X,Y),imp(Y,X) <=> X=Y.
 162
 163 labeling, imp(A,B)#Pc <=>
 164 label_imp(A,B),
 165 labeling
 166 pragma passive(Pc).
 167
 168 label_imp(0,X).
 169 label_imp(1,1).
 170
 171
 172
 173 %% Boolean cardinality operator
 174 %% card(A,B,L,N) constrains list L of length N to have between A and B 1s
 175
 176
 177 card(A,B,L):-
 178         length(L,N),
 179         A=<B,0=<B,A=<N,                         %0=<N
 180         card(A,B,L,N).
 181
 182 %% card/4 specification
 183 %%card(A,B,[],0):- A=<0,0=<B.
 184 %%card(A,B,[0|L],N):-
 185 %%              N1 is N-1,
 186 %%              card(A,B,L,N1).
 187 %%card(A,B,[1|L],N):-
 188 %%              A1 is A-1, B1 is B-1, N1 is N-1,
 189 %%              card(A1,B1,L,N1).
 190
 191 triv_sat @ card(A,B,L,N) <=> A=<0,N=<B | true. % trivial satisfaction
 192 pos_sat @ card(N,B,L,N) <=> set_to_ones(L).     % positive satisfaction
 193 neg_sat @ card(A,0,L,N) <=> set_to_zeros(L). % negative satisfaction
 194 pos_red @ card(A,B,L,N) <=> b_delete(X,L,L1),X==1 | % positive reduction
 195 A1 is A-1, B1 is B-1, N1 is N-1,
 196 card(A1,B1,L1,N1).
 197 neg_red @ card(A,B,L,N) <=> b_delete(X,L,L1),X==0 | % negative reduction
 198 N1 is N-1,
 199 card(A,B,L1,N1).
 200 %% special cases with two variables
 201 card2nand @ card(0,1,[X,Y],2) <=> and(X,Y,0).
 202 card2neg @ card(1,1,[X,Y],2) <=> neg(X,Y).
 203 card2or @ card(1,2,[X,Y],2) <=> or(X,Y,1).
 204
 205 b_delete( X, [X|L],  L).
 206 b_delete( Y, [X|Xs], [X|Xt]) :-
 207         b_delete( Y, Xs, Xt).
 208
 209 labeling, card(A,B,L,N)#Pc <=>
 210 label_card(A,B,L,N),
 211 labeling
 212 pragma passive(Pc).
 213
 214 label_card(A,B,[],0):- A=<0,0=<B.
 215 label_card(A,B,[0|L],N):-
 216         N1 is N-1,
 217         card(A,B,L).
 218 label_card(A,B,[1|L],N):-
 219         A1 is A-1, B1 is B-1, N1 is N-1,
 220         card(A1,B1,L).
 221
 222 set_to_ones([]).
 223 set_to_ones([1|L]):-
 224         set_to_ones(L).
 225
 226 set_to_zeros([]).
 227 set_to_zeros([0|L]):-
 228         set_to_zeros(L).
 229
 230
 231
 232 %% Auxiliary predicates
 233
 234 :- op(100,xfy,#).
 235
 236 solve_bool(A,C) :- var(A), !, A=C.
 237 solve_bool(A,C) :- atomic(A), !, A=C.
 238 solve_bool(A * B, C) :- !,
 239         solve_bool(A,A1),
 240         solve_bool(B,B1),
 241         and(A1,B1,C).
 242 solve_bool(A + B, C) :- !,
 243         solve_bool(A,A1),
 244         solve_bool(B,B1),
 245         or(A1,B1,C).
 246 solve_bool(A # B, C) :- !,
 247         solve_bool(A,A1),
 248         solve_bool(B,B1),
 249         xor(A1,B1,C).
 250 solve_bool(not(A),C) :- !,
 251         solve_bool(A,A1),
 252         neg(A1,C).
 253 solve_bool((A -> B), C) :- !,
 254         solve_bool(A,A1),
 255         solve_bool(B,B1),
 256         imp(A1,B1),C=1.
 257 solve_bool(A = B, C) :- !,
 258         solve_bool(A,A1),
 259         solve_bool(B,B1),
 260         A1=B1,C=1.
 261
 262 %% Labeling
 263 label_bool([]).
 264 label_bool([X|L]) :-
 265         ( X=0;X=1),
 266         label_bool(L).
 267
 268 /*                                                              % no write macros in SICStus and hProlog
 269
 270 bool_portray(and(A,B,C),Out):- !, Out = (A*B = C).
 271 bool_portray(or(A,B,C),Out):- !, Out = (A+B = C).
 272 bool_portray(xor(A,B,C),Out):- !, Out = (A#B = C).
 273 bool_portray(neg(A,B),Out):- !, Out = (A= not(B)).
 274 bool_portray(imp(A,B),Out):- !, Out = (A -> B).
 275 bool_portray(card(A,B,L,N),Out):- !, Out = card(A,B,L).
 276
 277 :- define_macro(type(compound),bool_portray/2,[write]).
 278 */
 279
 280 /* end of handler bool */
 281