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) 2006 Cisco Systems, Inc.  All Rights Reserved.
18%
19% Contributor(s): Mark Wallace, IC-Parc
20%
21% END LICENSE BLOCK
22:- module(probe_search).
23
24:- lib(fd).
25:- lib(repair).
26:- lib(eplex).
27
28
29:- use_module(bin_info).
30:- use_module(probe).
31:- use_module(make_overlap_bivs).
32:- use_module(probe_support).
33
34:- export probe_search/5.
35/*
36probe_search(?BivLists,?BivSums,+Resource,+Options,+Handle)
37Arguments:
38All these arguments are described above, viz:
39
40BivLists - A list of lists of binary variables, each of which has an attribute
41    recording which two tasks it relates
42BivSums - A list of finite domain variables recording the sum of the
43    binaries associated with a given task start time
44Resource - An integer indicating how many resources are available
45Cost - A variable whose value will be minimised during search
46Options - options structure
47Handle - Passed to add_cons.  Currently this is not used.
48
49    Based on the tentative assignments, find_bottleneck finds a task
50    start time where the resources are not sufficient to make the
51    tentative assignment feasible.  In case a bottleneck task has a
52    variable resource requirement, this is reduced to its minimum
53    possible value. Otherwise, find_bottleneck chooses a binary
54    "overlap" variable at this bottleneck.  add_biv_cstr then adds
55    a constraint trying to eliminate the overlap.
56
57*/
58
59
60probe_search(Bivs,BivSums,Resource,Options,Handle) :-
61    ( find_bottleneck(Bivs,BivSums,Resource,Biv)
62          ->  add_biv_cstr(Biv,Options,Handle),
63              probe_search(Bivs,BivSums,Resource,Options,Handle)
64      ;       true
65    ).
66
67/* The following predicates are used to distiguish between binary variables,
68representing the potential resource need if two tasks overlap, and
69resource variables representing a (variable) resource need, because
70the associated tasks DO overlap!
71*/
72
73biv_var(Biv) :-
74	get_bin_info(Biv,_).
75
76resource_var(Res) :-
77	var(Res),
78	mindomain(Res)>0.
79
80
81
82/*
83add_biv_cstr(-Biv,+Options,Handle)
84Arguments:
85Biv - a binary variable with an attribute recording which two tasks
86       it relates
87Options - options structure
88
89
90add_biv_cstr is used in search.  If the variable is a resource
91variable, it is simply set to its minimum value.  In this case the
92predicate is deterministic.
93
94Otherwise, add_biv_cstr tries setting the bivalued
95variable Biv to 0 and then on backtracking sets it to 1.  The
96subtlety lies in this: that Biv has an attribute recording the two
97tasks whose overlap it represents.  When setting Biv to 0,
98add_biv_cstr adds a constraint forcing these tasks apart.  When
99setting it to 1, add_biv_cstr forces the two tasks to overlap.
100
101It first tries forcing the first
102task to start after the second has finished.  On backtracking once it
103"gives up", sets the binary variable to the amount of resource required,
104and forces the two tasks to overlap.  On backtracking again it then tries
105to force the second task to start after the first.
106
107*/
108
109add_biv_cstr(Biv,_Options,_Handle) :-
110     resource_var(Biv), !,
111     set_to_min(Biv).
112
113add_biv_cstr(Biv,Options,Handle) :-
114     get_bin_info(Biv,(Task1,Task2)),
115     Task1 = task with start:S1,
116     Task2 = task with [start:S2,duration:D2,resource:R2],
117     (Biv=0,add_con([S1>=S2+D2],[fd,linear(Handle)],Options)
118      ;
119      Biv=R2,
120      add_con([S1>=S2,S1<S2+D2],[fd,linear(Handle)],Options)
121      ;
122      Biv=0,
123      add_con([S2>S1],[fd,linear(Handle)],Options)
124     ).
125
126/*
127find_bottleneck(+BivLists,+BivSums,++Resource,-Biv)
128BivLists - A list of (lists of binaries) - each list corresponding to
129a single task
130BivSums - A list of binary sums: each one, the sum of the list of
131binaries in the previous argument.
132Resource - The (integer) amount of resurce available
133Biv - The binary representing the two tasks which should be forced
134apart at the next choice point.
135
136find_bottleneck first of all chooses the bottleneck tasks.  These are
137the ones whose binary sums have the largest tentative value (which
138exceeds the resource limit).  All such tasks have the same tentative
139binary sum, 'Max'.  The difference between the resource limit and
140this upper bound, 'Excess', is the amount by which the resources must
141be reduced to meet the resource limit.
142
143The tightest binary is the one with the biggest overlap (from the
144previous probe) that must be set to zero to achieve feasibility.
145*/
146find_bottleneck(AllBivLists,BivSums,Resource,Biv) :-
147        max_tent_sum(AllBivLists,BivSums,Resource,Max,BivLists),
148        Excess is Max-Resource,
149        Excess>0,
150        find_tightest_biv(BivLists,Excess,Biv).
151
152/* Find all the bottlenecks - i.e. those tasks start times where the
153resource excess is greatest.  Each such bottleneck has an associated
154list of binary variables, BivList, and an associated sum of the binaries,
155BivSum.  All these bottlenecks have the same (excessive) resource
156requirement, Max.
157*/
158max_tent_sum(AllBivLists,BivSums,Resource,Max,BivLists) :-
159        (foreach(BivList,AllBivLists),
160	 foreach(BivSum,BivSums),
161         fromto(-1,TMax,NMax,Max),
162         fromto([],TList,NList,BivLists),
163         param(Resource)
164         do  (BivSum tent_get TSum,
165                ( TSum<Resource -> NMax=TMax, NList=TList
166                ; TSum>TMax ->   NMax=TSum, NList=[BivList]
167                ; TSum=TMax ->   NMax=TMax, NList=[BivList|TList]
168                ;                NMax=TMax, NList=TList
169                )
170             )
171        ).
172
173/*
174find_tightest_biv(?BivLists,+Excess,-OutBiv)
175BivLists - The list of lists, comprising the list of binaries for
176           each of the bottleneck tasks
177Excess - the (integer) amount by which the resources must be reduced
178         to meet the resource limit
179OutBiv - The chosen "tightest" binary
180
181find_tightest_biv finds a resource variable at a bottleneck,
182if there is one.
183
184Otherwise, for each bottleneck task, it returns the tightest
185binary, and gives it a score (the tentative overlap).  The chosen
186binary is the one with the greatest score.
187
188*/
189find_tightest_biv(BivLists,_,OutBiv) :-
190	member(BivList,BivLists),
191	member(OutBiv,BivList),
192	resource_var(OutBiv), !.
193
194
195
196find_tightest_biv(BivLists,Excess,OutBiv) :-
197	(foreach(BivList,BivLists),
198	 foreach((Olap-Biv),OlapBivs),
199         param(Excess) do
200            ftb(BivList,Excess,Olap,Biv)
201        ),
202        greatest_overlap(OlapBivs,OutBiv).
203
204/* Returns the binary variable with the greatest associated overlap
205*/
206greatest_overlap(OlapBivs,OutBiv) :-
207	( foreach(Olap-Biv,OlapBivs),
208	  fromto(0,ThisLeast,NextLeast,_),
209	  fromto(_,ThisBiv,NextBiv,OutBiv)
210	do
211	  (ThisLeast>=Olap -> [NextLeast,NextBiv] = [ThisLeast,ThisBiv]
212           ;                  [NextLeast,NextBiv] = [Olap,Biv]
213          )
214        ).
215
216
217/*
218ftb(?BivList,+Excess,-Olap,-Biv)
219ftb finds, among the binary variables with a non-zero tentative value,
220the "tightest" one that would still have to be set to zero even if we
221started from the least tight.  By "tighter" we mean "linking two tasks
222that have a larger overlap"
223*/
224
225ftb(BivList,Excess,Olap,Biv) :-
226        tent_olaps_only(BivList,BivVars,TentBivSum),
227        RemainingExcess is TentBivSum-Excess,
228	add_olap_key(BivVars,OlapBivList),
229        sort(1, '>=', OlapBivList, SortedOlapBivList),
230        tightest_non_olap(RemainingExcess,SortedOlapBivList,Olap-Biv).
231
232/* Select only binary variables that have a non-zero tentative value
233*/
234tent_olaps_only(List,Vars,TentSum) :-
235	( foreach(El,List),
236	  fromto([],This,Next,Vars),
237          fromto(0,ThisSum,NextSum,TentSumExpr)
238          do  (
239	         var(El), El tent_get T, T\==0 ->
240		          Next=[El|This],
241                          NextSum = ThisSum+T
242                  ;       Next=This,
243                          NextSum = ThisSum
244              )
245        ),
246        TentSum is TentSumExpr.
247
248/*
249Select the "tightest" binary variable that would still have to be set
250to zero even if we started from the least tight.
251*/
252tightest_non_olap(Excess,[Key-Biv|Bivs],Result) :-
253	RemainingExcess is Excess - tent_get(Biv),
254        (
255	    RemainingExcess<0 -> Result = Key-Biv
256         ;
257	    tightest_non_olap(RemainingExcess,Bivs,Result)
258        ).
259
260/* add_olap_key(List,OlapList)
261List - a list of binaries (with attribute bin_info)
262OlapList - a corresponding list of terms of the form Olap-Biv
263       where Olap is an integer representing the "tightness of the
264       binary.
265
266       These binaries represent the overlaps for a particular task
267       start time.  The aim is to find the task to force apart from
268       the given task so as to reduce the number of overlapping tasks.
269
270       The overlap is the minimum you would have to "push" the tasks
271       to prevent them overlapping.  Notice that this is NOT the
272       minimum you would have to "push" the tasks to set the overlap
273       binary to zero.  This can be achieved while the tasks still
274       overlap, as long as the start time of task1 does not overlap
275       with task 2.
276*/
277
278add_olap_key(List,OlapList) :-
279	( foreach(Biv,List), foreach(Olap-Biv,OlapList)
280        do
281             (    get_bin_info(Biv,(Task1,Task2)),
282                  Task1 = task with [start:S1,duration:D1],
283                  Task2 = task with [start:S2,duration:D2],
284                  Olap is min(tent_get(S2)+tent_get(D2)-tent_get(S1),
285                              tent_get(S1)+tent_get(D1)-tent_get(S2))
286             )
287        ).
288
289
290
291:- comment(categories, ["Constraints","Techniques"]).
292:- comment(summary, "Probe Search").
293:- comment(author, "Mark Wallace, Hani El Sakkout").
294:- comment(date, "$Date: 2009/07/16 09:11:27 $").
295:- comment(copyright, "Cisco Systems, Inc.").
296
297:- comment(desc, html("
298    A search routine which fixes resource bottlenecks by forcing tasks not to overlap.
299    ")).
300
301:- comment(probe_search/5, [
302    summary: "Add alternative constraints to try and repair infeasible probes",
303    amode:probe_search(+,+,++,++,+),
304    args:["Bivs": "A list of lists of binary integer variables",
305          "BivSums": "A list of integer variables, each one the sum of a list
306                      of binaries",
307          "Resource":"An integer quantity of resource available",
308          "Options":"An options structure",
309          "Handle":"A linear solver handle"
310        ],
311        resat:no,
312        see_also:[probe_cstr_sched/7,add_con/3],
313	desc:html("<P>
314    Based on the tentative assignments, <B>probe_search</B> finds a task
315    start time where the resources are not sufficient to make the
316    tentative assignment feasible.  In case a bottleneck task has a
317    variable resource requirement, this is reduced to its minimum
318    possible value. Otherwise, <B>probe_search</B> chooses a binary
319    'overlap' variable at this bottleneck and using <B>add_con</B> it adds
320    a constraint trying to eliminate the overlap.
321</P>
322")]).
323