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