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