% File: ~mack/prolog/csp.pl 
% Authors: David Poole and Alan Mackworth
% A CSP solver using arc consistency. 
% Last Modified: 9/Nov/90, 2/Oct/95
                                    
% csp(Domains, Relations) means that each variable has
% an instantiation to one of the values in its Domain 
% such that all the Relations are satisfied.
% Domains represented as list of 
% [dom(V,[c1,...,cn]),...]
% Relations represented as [rel([X,Y],r(X,Y)),...]
%  for some r
csp(Doms,Relns) :-
   ac(Doms,Relns).

ac(Doms,Relns) :-
   make_arcs(Relns,A),
   consistent(Doms,[],A,A).

make_arcs([],[]).
make_arcs([rel([X,Y],R)|O],
          [rel([X,Y],R),rel([Y,X],R)|OA]) :-
   make_arcs(O,OA).

consistent(Doms,CA,TDA,A) :-
   consider(Doms,RedDoms,CA,TDA),
   solutions(RedDoms,A).            

% consider(D0,D1,CA,TDA) CA = consistent arcs, 
% TDA = to do arcs
consider(D,D,_,[]).
consider(D0,D3,CA,[rel([X,Y],R)|TDA]) :-
   select(dom(XV,DX),D0,D1),X==XV,
   select(dom(YV,DY),D1,_),Y==YV,
   prune(X,DX,Y,DY,R,NDX),
   ( NDX = DX,!,
     consider(D0,D3,[rel([X,Y],R)|CA],TDA)
   ; acc_todo(X,Y,CA,CA1,TDA,TDA1),
     consider([dom(X,NDX)|D1],D3,
              [rel([X,Y],R)|CA1],TDA1)).

prune(_,[],_,_,_,[]).
prune(X,[V|XD],Y,YD,R,[V|XD1]):-
   \+ (\+ (X=V,member(Y,YD),R)),!,
   prune(X,XD,Y,YD,R,XD1).
prune(X,[_|XD],Y,YD,R,XD1):-
   prune(X,XD,Y,YD,R,XD1).

acc_todo(_,_,[],[],TDA,TDA).        
acc_todo(X,Y,[rel([U,V],R)|CA0],
         [rel([U,V],R)|CA1],TDA0,TDA1) :-
   ( X \== V
   ; X == V,
     Y == U),   
   acc_todo(X,Y,CA0,CA1,TDA0,TDA1).
acc_todo(X,Y,[rel([U,V],R)|CA0],
         CA1,TDA0,[rel([U,V],R)|TDA1]) :-
   X == V,
   Y \== U,
   acc_todo(X,Y,CA0,CA1,TDA0,TDA1).

solutions(Doms,_) :-
   singletons(Doms),!,
   solve(Doms).
solutions(Doms,A) :-
   select(dom(X,[XV1,XV2|XVs]),Doms,ODoms),
   split([XV1,XV2|XVs],DX1,DX2),!,
   acc_todo(X,_,A,CA,[],TDA),
   ( consistent([dom(X,DX1)|ODoms],CA,TDA,A)
   ; consistent([dom(X,DX2)|ODoms],CA,TDA,A)).
                                    
singletons([]).
singletons([dom(_,[_])|Doms]) :- singletons(Doms).

select(D,Doms,ODoms) :- remove(D,Doms,ODoms). 

solve([]).
solve([G|T]) :- G, solve(T).

dom(X,DX) :- member(X,DX).

split(L,L1,L2) :-
    append(L1,L2,L),
    similar_size(L1,L2).

% similar_size(List1,List2) means that List1 has 
% one more, one less or exactly the same number 
% of items as List2.
similar_size([_],[]).
similar_size([],[_]).
similar_size([],[]).
similar_size([_|T1],[_|T2]) :- similar_size(T1,T2).
