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 Integer Programming All Minimum-cost cuts Library
16% The Initial Developer of the Original Code is  CrossCore Optimization Ltd.
17% Portions created by the Initial Developer are  Copyright (C)2007.
18% All Rights Reserved.
19% 
20% 
21% END LICENSE BLOCK
22%
23%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
24
25:-module(all_min_cuts_eplex).
26:-comment(categories, ["Algorithms"]).
27:-comment(summary,"Mixed integer programming solution for generating all minimum-cost cuts").
28:-comment(desc,"Mixed integer programming solution for generating all"
29               " minimum-cost cuts between given source and sink nodes."
30               " This formulation was used as a comparison algorithm in"
31               " the experimental section of [Norman D. Curet,"
32               " Jason DeVinney, Matthew E. Gaston. An efficient"
33               " network flow code for finding all minimum cost s-t"
34               " cutsets. Computers & Operations Research 29 (2002)"
35               " 205-219]. The idea is to iteratively solve dual max flow"
36               " problem, and at each iteration, post an additional"
37               " contraint to avoid" 
38               " repeating the same cuts.").
39:-comment(author,"CrossCore Optimization Ltd").
40:-comment(copyright,"2007, CrossCore Optimization Ltd").
41:-comment(status,prototype).
42:-comment(date,"2006-2007").
43
44:-lib(graph_algorithms).
45:-lib(hash).
46:-lib(eplex).
47
48
49:- export(all_min_cuts_eplex/7).
50:- comment(all_min_cuts_eplex/7,
51          [
52              summary:"MIP algorithm for generating all minimum-"
53                      "cost cuts", 
54              amode:all_min_cuts_eplex(+,+,+,+,-,-,-),
55              args:[
56                       "Graph": "a graph structure, no parallel edges,"
57                                " e(Src,Dest,EdgeData)", 
58                       "CapacityArg": "which argument of EdgeData to use as"
59                                      " edge capacity (integer), (0 if"
60                                      " EdgeData is a single number and -1"
61                                      " if every edge capacity is 1)",
62                       "SourceNode": "source node number (integer)",
63                       "SinkNode": "sink node number (integer)",
64                       "MaxFlowValue": "value of the maximum flow"
65                                       " flow (form: Flow-Edge)",
66                       "MinCuts": "list of all minimum cost cutsets (each"
67                                  " cutset is represented by a list of"
68                                  " nodes belonging to the source-side of"
69                                  " the cut)",
70                       "MinCutEdges": "list of all minimum cost cutsets"
71                                      " (each cutset is represented by a"
72                                      " list of edges that separate the"
73                                      " source-side and the sink-side of"
74                                      " the cut)"
75                   ],
76              see_also:[max_flow:max_flow/5,
77                        max_flow:max_flow/7,
78                        max_flow_eplex:max_flow_eplex/5,
79                        max_flow_eplex:max_flow_eplex_dual/5,
80                        max_flow_eplex:max_flow_eplex_dual/7,
81                        all_min_cuts:all_min_cuts/8,
82                        all_min_cuts:all_min_cuts/9,
83                        all_min_cuts:all_min_cuts_list/5,
84                        all_min_cuts_eplex:all_min_cuts_eplex/7,
85                        all_min_cuts_eplex:all_min_cuts_eplex/8
86                       ]
87          ]
88         ).
89
90:- export(all_min_cuts_eplex/8).
91:- comment(all_min_cuts_eplex/8,
92          [
93              summary:"MIP algorithm for generating all minimum-"
94                      "cost cuts, with a limit for max allowed number of"
95                      " generated cuts", 
96              amode:all_min_cuts_eplex(+,+,+,+,+,-,-,-),
97              args:[
98                       "Graph": "a graph structure, no parallel edges,"
99                                " e(Src,Dest,EdgeData)", 
100                       "CapacityArg": "which argument of EdgeData to use as"
101                                      " edge capacity (integer), (0 if"
102                                      " EdgeData is a single number and -1"
103                                      " if every edge capacity is 1)",
104                       "SourceNode": "source node number (integer)",
105                       "SinkNode": "sink node number (integer)",
106                       "Limit" : "max number of min cuts to output"
107                                 " (integer), if Limit = 0 then output all"
108                                 " possible" 
109                                 " mincuts",
110                       "MaxFlowValue": "value of the maximum flow"
111                                       " flow (form: Flow-Edge)",
112                       "MinCuts": "list of all minimum cost cutsets (each"
113                                  " cutset is represented by a list of"
114                                  " nodes belonging to the source-side of"
115                                  " the cut)",
116                       "MinCutEdges": "list of all minimum cost cutsets"
117                                      " (each cutset is represented by a"
118                                      " list of edges that separate the"
119                                      " source-side and the sink-side of"
120                                      " the cut)"
121                   ],
122              see_also:[max_flow:max_flow/5,
123                        max_flow:max_flow/7,
124                        max_flow_eplex:max_flow_eplex/5,
125                        max_flow_eplex:max_flow_eplex_dual/5,
126                        max_flow_eplex:max_flow_eplex_dual/7,
127                        all_min_cuts:all_min_cuts/8,
128                        all_min_cuts:all_min_cuts/9,
129                        all_min_cuts:all_min_cuts_list/5,
130                        all_min_cuts_eplex:all_min_cuts_eplex/7,
131                        all_min_cuts_eplex:all_min_cuts_eplex/8
132                       ]
133          ]
134         ).
135
136
137all_min_cuts_eplex(Graph,CapacityArg,SourceNode,SinkNode,MaxFlowValue,
138                    MinCuts,MinCutEdges):-  
139        all_min_cuts_eplex(Graph,CapacityArg,SourceNode,SinkNode,0,
140                           MaxFlowValue, MinCuts,MinCutEdges).
141
142        
143all_min_cuts_eplex(Graph,CapacityArg,SourceNode,SinkNode,Limit,MaxFlowValue,
144                    MinCuts,MinCutEdges):-  
145        
146        eplex: eplex_solver_setup(min(ObjFn)),
147
148        % setup the dual maxflow model
149        dual_model(Graph,CapacityArg,SourceNode,SinkNode,NodeVars,
150                   EdgeVars,ObjFn), 
151
152        % get first solution
153        eplex: eplex_solve(MaxFlowValue),
154        output_cut(Graph,NodeVars,EdgeVars,MinCut1,MinCutEdgeSet1),
155        
156        % get more solutions if there are:
157        (
158            count(I,1,_),
159            fromto([MinCut1],MinCutsIn,MinCutsOut,MinCuts),
160            fromto([MinCutEdgeSet1],MinCutEdgesIn,MinCutEdgesOut,MinCutEdges),
161            fromto(false,_,Stop,true),
162            param(Graph,NodeVars,EdgeVars,MaxFlowValue,Limit)
163        do
164            (
165                I == Limit
166            ->
167                % no more solutions allowed by the user
168                MinCutsOut = MinCutsIn,
169                MinCutEdgesOut = MinCutEdgesIn,
170                Stop = true
171            ;
172                
173                % take previous optimal solution
174                MinCutEdgesIn = [PreviousCutEdges|_],
175                
176                % post new constraint
177                post_cut_cardinality_constraint(PreviousCutEdges,EdgeVars),
178                
179                % solve again, still possible to get a min cut?
180                
181                (
182                    eplex: eplex_solve(Value),
183                    Value == MaxFlowValue
184                ->
185                    % collect the solution and try again
186                    output_cut(Graph,NodeVars,EdgeVars,MinCut,MinCutEdgeSet),
187                    MinCutsOut = [MinCut|MinCutsIn],
188                    MinCutEdgesOut = [MinCutEdgeSet|MinCutEdgesIn],
189                    Stop = false
190                ;
191                    % no optimal solutions left, stop
192                    MinCutsOut = MinCutsIn,
193                    MinCutEdgesOut = MinCutEdgesIn,
194                    Stop = true
195                )
196            )
197        ),
198        eplex: eplex_cleanup.
199
200
201
202        
203dual_model(Graph,CapacityArg,SourceNode,SinkNode,NodeVars,
204           EdgeVars,ObjFn):-
205        
206        graph_get_maxnode(Graph,N),
207        dim(NodeVars,[N]),
208        (
209            foreacharg(Y,NodeVars)
210        do
211            eplex: (integers(Y)),
212            eplex: (Y $>= 0),
213            eplex: (Y $=< 1)
214        ),
215        
216        graph_get_all_edges(Graph,Edges),
217        hash_create(EdgeVars),        
218        (
219            foreach(e(I,J,Info),Edges),
220            foreach(Z,EdgeVarList),
221            foreach(Capacity,EdgeCapacityList),
222            param(EdgeVars,CapacityArg,NodeVars)
223        do
224            eplex: (integers(Z)),
225            eplex: (Z $>= 0),
226            eplex: (Z $=< 1),
227            hash_add(EdgeVars,key(I,J),Z),
228            
229            capacity(CapacityArg,Info,Capacity),
230            
231            arg(I,NodeVars,Y_i),
232            arg(J,NodeVars,Y_j),
233            eplex: (Y_i - Y_j + Z $>= 0)
234
235        ),
236        
237        arg(SourceNode,NodeVars,Y_s),
238        arg(SinkNode,NodeVars,Y_t),
239        eplex: ( Y_s $= 0 ),
240        eplex: ( Y_t $= 1 ),
241             
242        eplex: (ObjFn $= EdgeCapacityList * EdgeVarList).
243        
244                    
245post_cut_cardinality_constraint(CutEdges,EdgeVars):-
246        %% this constraint forces a different mincut
247        
248        (
249            foreach(e(I,J,_),CutEdges),
250            fromto([],In,[Var|In],CutEdgeVars),
251            param(EdgeVars)
252        do
253            hash_get(EdgeVars,key(I,J),Var)
254        ),
255        
256        % cardinality of previous optimal solution:
257        
258        length(CutEdges,Card),
259        
260        % next solution can contain no more than (Card-1) same edges:
261        eplex: eplex_add_constraints([( sum(CutEdgeVars) $=< Card - 1)],[]).
262
263        
264output_cut(Graph,NodeVars,EdgeVars,MinCutNodes,MinCutEdges):-
265        (
266            count(I,1,_),
267            foreacharg(Y,NodeVars),
268            fromto([],In,Out,MinCutNodes)
269        do
270            eplex: eplex_var_get(Y,typed_solution,Sol),
271            (
272                Sol == 0
273            -> 
274                Out = [I|In]
275            ;
276                Out = In
277            )
278        ),
279
280        hash_list(EdgeVars,EdgeKeys,EdgeVarsList),
281        (
282            foreach(key(I,J),EdgeKeys),
283            foreach(Z,EdgeVarsList),
284            fromto([],In,Out,MinCutEdges),
285            param(Graph)
286        do
287            eplex: eplex_var_get(Z,typed_solution,Sol),
288            (
289                Sol == 1
290            -> 
291                graph_get_edge(Graph,I,J,Edge),
292                Out = [Edge|In]
293            ;
294                Out = In
295            )
296        ).
297
298
299capacity(-1,_EdgeInfo,1):-!.
300capacity(0,EdgeInfo,EdgeInfo):-!.
301capacity(CapacityArg,EdgeInfo,Capacity):-
302        CapacityArg > 0,
303        !,
304        arg(CapacityArg,EdgeInfo,Capacity).
305capacity(_,_,_):-!,fail.
306
307