Examples/listdom.chr

   1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   2 %%
   3 %% Slim Abdennadher, Thom Fruehwirth, LMU, July 1998
   4 %% Finite (enumeration, list) domain solver over integers
   5 %%
   6 %% * ported to hProlog by Tom Schrijvers, K.U.Leuven
   7
   8 % :- module(listdom,[]).
   9
  10 :- use_module( library(chr)).
  11
  12 :- use_module( library(lists)).
  13
  14
  15 %% for domain constraints
  16 :- op( 700,xfx,'::').
  17 :- op( 600,xfx,'..').
  18
  19 %% for inequality constraints
  20 :- op( 700,xfx,lt).
  21 :- op( 700,xfx,le).
  22 :- op( 700,xfx,ne).
  23
  24 %% for domain constraints
  25 ?- op( 700,xfx,'::').
  26 ?- op( 600,xfx,'..').
  27
  28 %% for inequality constraints
  29 ?- op( 700,xfx,lt).
  30 ?- op( 700,xfx,le).
  31 ?- op( 700,xfx,ne).
  32
  33 :- constraints (::)/2, (le)/2, (lt)/2, (ne)/2, add/3, mult/3.
  34 %% X::Dom - X must be element of the finite list domain Dom
  35
  36 %% special cases
  37 X::[] <=> fail.
  38 %%X::[Y] <=> X=Y.
  39 %%X::[A|L] <=> ground(X) | (member(X,[A|L]) -> true).
  40
  41 %% intersection of domains for the same variable
  42 X::L1, X::L2 <=> is_list(L1), is_list(L2) |
  43 intersection(L1,L2,L) , X::L.
  44
  45 X::L, X::Min..Max <=> is_list(L) |
  46 remove_lower(Min,L,L1), remove_higher(Max,L1,L2),
  47 X::L2.
  48
  49
  50 %% interaction with inequalities
  51
  52 X le Y, X::L1,  Y::L2 ==> is_list(L1),is_list(L2),
  53 min_list(L1,MinX), min_list(L2,MinY), MinX > MinY |
  54 max_list(L2,MaxY), Y::MinX..MaxY.
  55 X le Y, X::L1,  Y::L2 ==> is_list(L1),is_list(L2),
  56 max_list(L1,MaxX), max_list(L2,MaxY), MaxX > MaxY  |
  57 min_list(L1,MinX), X::MinX..MaxY.
  58
  59 X lt Y, X::L1,  Y::L2 ==> is_list(L1), is_list(L2),
  60 max_list(L1,MaxX), max_list(L2,MaxY),
  61 MaxY1 is MaxY - 1, MaxY1 < MaxX |
  62 min_list(L1,MinX), X::MinX..MaxY1.
  63 X lt Y, X::L1,  Y::L2 ==> is_list(L1), is_list(L2),
  64 min_list(L1,MinX), min_list(L2,MinY),
  65 MinX1 is MinX + 1, MinX1 > MinY |
  66 max_list(L2,MaxY), Y :: MinX1..MaxY.
  67
  68 X ne Y \  Y::D <=> ground(X), is_list(D), member(X,D) | select(X,D,D1), Y::D1.
  69 Y ne X \  Y::D <=> ground(X), is_list(D), member(X,D) | select(X,D,D1), Y::D1.
  70 Y::D \ X ne Y <=>  ground(X), is_list(D), \+ member(X,D) | true.
  71 Y::D \ Y ne X <=>  ground(X), is_list(D), \+ member(X,D) | true.
  72
  73
  74 %% interaction with addition
  75 %% no backpropagation yet!
  76
  77 add(X,Y,Z), X::L1, Y::L2 ==> is_list(L1), is_list(L2) |
  78 all_addition(L1,L2,L3), Z::L3.
  79
  80 %% interaction with multiplication
  81 %% no backpropagation yet!
  82
  83 mult(X,Y,Z), X::L1, Y::L2 ==> is_list(L1), is_list(L2) |
  84 all_multiplication(L1,L2,L3), Z::L3.
  85
  86
  87 %% auxiliary predicates =============================================
  88
  89 remove_lower(_,[],L1):- !, L1=[].
  90 remove_lower(Min,[X|L],L1):-
  91         X@<Min,
  92         !,
  93         remove_lower(Min,L,L1).
  94 remove_lower(Min,[X|L],[X|L1]):-
  95         remove_lower(Min,L,L1).
  96
  97 remove_higher(_,[],L1):- !, L1=[].
  98 remove_higher(Max,[X|L],L1):-
  99         X@>Max,
 100         !,
 101         remove_higher(Max,L,L1).
 102 remove_higher(Max,[X|L],[X|L1]):-
 103         remove_higher(Max,L,L1).
 104
 105 intersection([], _, []).
 106 intersection([Head|L1tail], L2, L3) :-
 107         memberchk(Head, L2),
 108         !,
 109         L3 = [Head|L3tail],
 110         intersection(L1tail, L2, L3tail).
 111 intersection([_|L1tail], L2, L3) :-
 112         intersection(L1tail, L2, L3).
 113
 114 all_addition(L1,L2,L3) :-
 115         setof(Z, X^Y^(member(X,L1), member(Y,L2), Z is X + Y), L3).
 116
 117 all_multiplication(L1,L2,L3) :-
 118         setof(Z, X^Y^(member(X,L1), member(Y,L2), Z is X * Y), L3).
 119
 120
 121 %% EXAMPLE ==========================================================
 122
 123 /*
 124 ?- X::[1,2,3,4,5,6,7], Y::[2,4,6,7,8,0], Y lt X, X::4..9, X ne Y,
 125 add(X,Y,Z), mult(X,Y,Z).
 126 */
 127
 128 %% end of handler listdom.pl =================================================
 129 %% ===========================================================================
 130
 131
 132 /*
 133
 134 ?- X::[1,2,3,4,5,6,7], Y::[2,4,6,7,8,0], Y lt X, X::4..9, X ne Y,
 135    add(X,Y,Z), mult(X,Y,Z).
 136
 137 Bad call to builtin predicate: _9696 =.. ['add/3__0',AttVar4942,AttVar5155,AttVar6836|_9501] in predicate mknewterm / 3
 138 */