1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The ECLiPSe Constraint Logic Programming System. 15% The Initial Developer of the Original Code is Cisco Systems, Inc. 16% Portions created by the Initial Developer are 17% Copyright (C) 1999 - 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): 20% 21% END LICENSE BLOCK 22% ---------------------------------------------------------------------- 23% System: ECLiPSe Constraint Logic Programming System 24% Version: $Id: frequency.pl,v 1.1 2006/09/23 01:53:31 snovello Exp $ 25% ---------------------------------------------------------------------- 26 27:- lib(fd). 28:- lib(fd_global). 29 30/* 31 32Example 33 34Prunes domains of variables: 35L=[X1,X2,X3,X4],L::1..10,O1#>0,O2#>0,O3#>0,frequency(L,[O1,O2,O3],[1,2,3]),X1=4. 36 37Instantiates occurences: 38L=[X1,X2,X3,X4],L::1..10,O1#>0,O2#>0,O3#>1,frequency(L,[O1,O2,O3],[1,2,3]). 39 40 41Instantiates all variables: 42 L=[X1,X2,X3,X4],L::1..10,O1#>0,O2#>0,O3#>0,frequency(L,[O1,O2,O3],[1,2,3]),X1#<X2,X2#<X3,X3#<X4,X4=4. 43 44*/ 45 46% frequency(+List,+Occurences,++Values) 47% An aggregate constraint of occurrences: 48% Each value in Values should occur exactly in List 49% as many times is specified in Occurences 50% Precondition: len(Occurences) = len(Values) 51% Values should be a list of ground values 52% List should be a list of domain variables 53% Occurences should be a list of domain variables 54% 55% Example: 56% 57% frequency([1,2,3,4],[1,1],[2,3]) succeeds 58% frequency([1,2,3,4],[1,0],[2,3]) fails 59% frequency([1,2,2,4],L,[1,2,3,4]) succeeds with 60% L = [1, 2, 0, 1] 61 62 63frequency(List,Occurences,Values):- 64 ( param(List), 65 foreach(V,Values), 66 foreach(O,Occurences) 67 do 68 occurrences(V,List,O) 69 ), 70 length(List,N), 71 Sum #= sum(Occurences), 72 Sum #<= N, 73 list_to_dom(Values, ValuesDom), 74 frequency_aux(List,Occurences,Values,ValuesDom,Sum). 75 76 77frequency_aux(OldVars,Occs,Vals,ValuesDom,S):- 78 remove_other_values(OldVars,ValuesDom,Vars,Len), 79 S #<= Len, 80 mindomain(S,MinS), 81 (MinS == Len -> 82 % Need to filter values to find out which values have not been 83 % assigned yet in order to construct the domain of the remaining 84 % variables in the list 85 (param(Vars),foreach(Val,Vals),foreach(Occ,Occs),fromto(Domain,Out,In,[]) do 86 count_vars(Val,Vars,0,Lower,0,_Upper,_), 87 mindomain(Occ,MinO), 88 (Lower >= MinO -> % constraint satisfied 89 Out = In 90 ; 91 Out = [Val|In] 92 ) 93 ), 94 list_to_dom(Domain,Dom), 95 (param(Dom),foreach(V,Vars) do 96 (nonvar(V) -> 97 true 98 ; 99 dvar_domain(V,OldDomain), 100 dom_intersection(OldDomain,Dom,NewDom,_), 101 dvar_update(V,NewDom) 102 ) 103 ) 104 105 ; 106 Var = v(Occs,Vars), 107 suspend(frequency_aux(Vars,Occs,Vals,ValuesDom,S),4,[S->min,Var->any]) 108 ). 109 110% remove_other_values(OldVars,Values,NewVars,Len) 111 112remove_other_values(OldVars,Values,NewVars,Len):- 113 remove_other_values(OldVars,Values,NewVars,0,Len). 114 115remove_other_values([H|T],Values,NewVars,Sofar,Len):- 116 dvar_domain(H, HDom), 117 (dom_intersection(Values,HDom,_,_) -> 118 Acc is Sofar + 1, 119 NewVars = [H|Rest] 120 ; 121 Acc = Sofar, 122 NewVars = Rest 123 ), 124 remove_other_values(T,Values,Rest,Acc,Len). 125remove_other_values([],_Values,[],Len,Len). 126 127% Taken from fd_global.pl library 128 129% count_vars(+Value,+Vars,-Lower,-Upper,-VarsWithValue) 130% Given an integer value and a list of finite domain variables 131% Returns a lower and an upper bound of the times this value 132% appear in the variable list as well as the variables which 133% may or may not hold this value in the future. 134% The lower bound refers to the number of times a variable was 135% instantiated to the value. 136% The upper bound refers to the number of uninstantiated variables 137% which can still take this value. 138% The VarsWithValue are the uninstantiated variables... 139 140%count_vars(Value,Vars,Lower,Upper,VarsWithValue):- 141% count_vars(Value,Vars,0,Lower,0,Upper,VarsWithValue). 142 143count_vars(_,[],Lower,Lower,Upper,Upper,[]). 144count_vars(Value,[H|T],Lower1,Lower,Upper1,Upper,VarsWithValue) :- 145 dvar_domain(H,DH), 146 ( dom_check_in(Value,DH) -> 147 Upper2 is Upper1 + 1, % Value in domain 148 ( H == Value -> 149 Lower2 is Lower1 + 1, % H is instantiated to Value! 150 VarsWithValue = MoreWithValue 151 ; 152 Lower2 = Lower1, 153 VarsWithValue = [H|MoreWithValue] 154 ), 155 count_vars(Value,T,Lower2,Lower,Upper2,Upper,MoreWithValue) 156 ; 157 count_vars(Value,T,Lower1,Lower,Upper1,Upper,VarsWithValue) 158 ). 159 160 161 162 163%---------------------------------------------------------------------- 164% multi_occurrences(++Values, +List, ?Occs) 165%---------------------------------------------------------------------- 166 167multi_occurrences(Values, List, Occs) :- 168 nonground(Values, SomeVar), !, 169 suspend(occurrences(Values, List, Occs), 3, SomeVar->inst). 170multi_occurrences(Values, List, Occs) :- 171 ( 172 fromto(List, XXs, Xs, []), 173 foreach(Susp,Susps), 174 param(List,Values,Occs) 175 do 176 XXs = [X|Xs], 177 sublist(List, XXs, ListWithoutX), 178 suspend(multi_occurrences(Values, X, ListWithoutX, Occs, Susp), 179 4, X->any, Susp) 180 ), 181 schedule_woken(Susps), wake. 182 183% Ys_Zs is the list Ys_X_Zs without X (the first element of X_Zs) 184sublist(Ys_X_Zs, X_Zs, Ys_Zs) :- 185 ( Ys_X_Zs == X_Zs -> 186 X_Zs = [_X|Ys_Zs] 187 ; 188 Ys_X_Zs = [Y|Ys_X_Zs1], 189 Ys_Zs = [Y|Ys_Zs1], 190 sublist(Ys_X_Zs1, X_Zs, Ys_Zs1) 191 ). 192 193:- demon multi_occurrences/5. 194multi_occurrences(Values, X, ListWithoutX, Occs, _Susp) :- 195 ( nonvar(X) -> kill_suspension(Susp) ; true ), 196 dvar_domain(X, DX), 197 dom_size(DX, Size), 198 count_subsets(DX, ListWithoutX, Size, 1, Count, Others), 199 ( Count == Size -> 200 call_priority(update_domains(Others), 2) 201 ; 202 true 203 ). 204 205 206not_among(X,ListWithoutX):- 207 nonvar(X), 208 call_priority(remove_element(ListWithoutX,X), 2). 209not_among(X,ListWithoutX):- 210 var(X), 211 dvar_domain(X,DX), 212 dom_size(DX,Size), 213 count_subsets(DX,ListWithoutX,Size,1,Count,Others), 214 make_suspension(not_among(X,ListWithoutX),4,Susp), 215 insert_suspension(X,Susp,any of fd,fd), 216 ( Count == Size -> 217 call_priority(update_domains(Others), 2) 218 ; 219 true 220 ). 221 222count_subsets(_,[],_,N,N,[]). 223count_subsets(Dom,[H|T],Dom_Size,Sofar,N,Others):- 224 dvar_domain(H,DH), 225 (dom_difference(DH,Dom,Diff,_)-> 226 % DH not a subset of Dom 227 Others = [H-Diff|Others0], 228 count_subsets(Dom,T,Dom_Size,Sofar,N,Others0) 229 ; 230 % DH subset of Dom 231 Count is Sofar + 1, 232 Count =< Dom_Size, 233 count_subsets(Dom,T,Dom_Size,Count,N,Others) 234 ). 235 236update_domains([]). 237update_domains([X-D|XDs]) :- 238 dvar_update(X,D), 239 update_domains(XDs). 240 241remove_element([],_). 242remove_element([X|Xs],E) :- 243 dvar_remove_element(X,E), 244 remove_element(Xs,E). 245 246 247 248