1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1995-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: fd_chip.pl,v 1.1 2008/06/30 17:43:45 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30/*
31 * SEPIA PROLOG SOURCE MODULE
32 */
33
34/*
35 * FINITE DOMAINS
36 *
37 * IDENTIFICATION:      chip.pl
38 *
39 * AUTHOR:		Micha Meier
40 *
41 * DESCRIPTION:         CHIP compatibility package.
42 */
43
44
45:- module(fd_chip).
46
47:- import fd_arith.
48:- import fd_util.
49
50:- export
51    deletemin/3,
52
53    % CHIP 3:
54%    dvar/1,
55%    dvarint/2,
56
57%    indomain/2,
58%    delete/5,
59
60%    domain_info/6,
61    dom/2,
62
63    % CHIP 2:
64    deleteff/3,
65    deleteffc/3,
66    maxdomain/2,
67    mindomain/2,
68
69    alldistinct/1.
70
71:- pragma(nodebug).
72:- pragma(system).
73
74
75%
76% Transformation routines
77%
78
79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80% Input goal transformation
81%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
82
83% Goal Source Transformation
84
85%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
86% Output goal transformation
87%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
88
89
90%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91% Built-In Predicates for CHIP compatibility
92%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
93
94dom(_{fd:(fd with domain:D)}, List) :-
95	-?->
96	!,
97	dom_to_list(D, List).
98dom(A, L) :-
99	atomic(A),
100	!,
101	L = [A].
102dom(X, List) :-
103	error(4, dom(X, List)).
104
105mindomain(Var, Min) :-
106    (dvar_range(Var, Min0, _) ->
107	Min = Min0
108    ;
109	error(5, mindomain(Var, Min))
110    ).
111
112maxdomain(Var, Max) :-
113    (dvar_range(Var, _, Max0) ->
114	Max = Max0
115    ;
116	error(5, maxdomain(Var, Max))
117    ).
118
119
120%
121% The predicates for first fail principle
122% They are written such that they don't perturb the list order
123%
124
125deleteff(Var, List, Rest) :-
126    List = [H|T],
127    dvar_size(H, Card),
128    ( Card == 1 ->
129	Rest = T,
130    	Var = H
131    ;
132	find_least_domain(T, List, Card, Chosen, Rest),
133	Var = Chosen
134    ).
135
136%:- mode find_least_domain(+,+,+,-,-).
137find_least_domain([], SoFar, _OldCard, BestVar, Rest) :- !,
138    SoFar = [BestVar|Rest].
139find_least_domain(List, SoFar, OldCard, BestVar, Rest) :-
140    List = [Var|Vars],
141    dvar_size(Var, NewCard),
142    ( NewCard == 1 ->				% take constant and stop
143	BestVar = Var,
144    	copy_until(SoFar, List, Rest, Vars)
145    ; NewCard >= OldCard ->			% keep old one
146	find_least_domain(Vars, SoFar, OldCard, BestVar, Rest)
147    ;						% new optimum
148    	copy_until(SoFar, List, Rest, Rest0),
149	find_least_domain(Vars, List, NewCard, BestVar, Rest0)
150    ).
151
152
153deleteffc(Var, List, Rest) :-
154    List = [H|T],
155    dvar_size(H, Card),
156    (Card == 1 ->
157	Rest = T,
158	Var = H
159    ;
160	find_least_domainffc(T, List, Card, _Num, Chosen, Rest),
161	Var = Chosen
162    ).
163
164%:- mode find_least_domain(+,+,+,?,-,-).
165find_least_domainffc([], SoFar, _OldCard, _OldNum, BestVar, Rest) :- !,
166    SoFar = [BestVar|Rest].
167find_least_domainffc(List, SoFar, OldCard, OldNum, BestVar, Rest) :-
168    List = [Var|Vars],
169    dvar_size(Var, NewCard),
170    ( NewCard == 1 ->				% take constant and stop
171	BestVar = Var,
172    	copy_until(SoFar, List, Rest, Vars)
173    ; NewCard > OldCard ->			% keep old one
174	find_least_domainffc(Vars, SoFar, OldCard, OldNum, BestVar, Rest)
175    ; NewCard < OldCard ->			% new optimum
176	copy_until(SoFar, List, Rest, Rest0),
177	find_least_domainffc(Vars, List, NewCard, _Num, BestVar, Rest0)
178    ;
179	% compute constraints_number of best lazily:
180	( var(OldNum) -> constraints_number(BestVar, OldNum) ; true ),
181	constraints_number(Var, Num),
182	( Num =< OldNum ->			% keep old one
183	    find_least_domainffc(Vars, SoFar, OldCard, OldNum, BestVar, Rest)
184	;					% new optimum
185	    copy_until(SoFar, List, Rest, Rest0),
186	    find_least_domainffc(Vars, List, NewCard, Num, BestVar, Rest0)
187	)
188    ).
189
190
191% find the List element with the smallest lower bound
192
193deletemin(Var, List, Rest) :-
194    List = [H|T],
195    dvar_range(H, Min, _),
196    find_min_domain(T, List, Min, Chosen, Rest),
197    Var = Chosen.
198
199%:- mode find_min_domain(+,+,+,-,-).
200find_min_domain([], SoFar, _OldMin, BestVar, Rest) :- !,
201    SoFar = [BestVar|Rest].
202find_min_domain(List, SoFar, OldMin, BestVar, Rest) :-
203    List = [Var|Vars],
204    dvar_range(Var, NewMin, _),
205    ( NewMin >= OldMin ->			% keep old one
206	find_min_domain(Vars, SoFar, OldMin, BestVar, Rest)
207    ;						% new optimum
208    	copy_until(SoFar, List, Rest, Rest0),
209	find_min_domain(Vars, List, NewMin, BestVar, Rest0)
210    ).
211
212
213    % Copy list In until a tail matching Until is reached.
214    % Output in difference list Out-Out0
215    copy_until(In, Until, Out, Out0) :-
216    	( In == Until ->
217	    Out = Out0
218	;
219	    In = [X|In1],
220	    Out = [X|Out1],
221	    copy_until(In1, Until, Out1, Out0)
222	).
223
224
225alldistinct([]).
226alldistinct([H|T]) :-
227    outof(H, T),
228    alldistinct(T).
229
230