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