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 Linear Programming Maximum Flow Library
16% The Initial Developer of the Original Code is  CrossCore Optimization Ltd.
17% Portions created by the Initial Developer are  Copyright (C) 2006-2007.
18% All Rights Reserved.
19% 
20% 
21% END LICENSE BLOCK
22%
23%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
24
25:-module(max_flow_eplex).
26:-comment(categories, ["Algorithms"]).
27:-comment(summary,"Linear programming solution for maximum flow problem").
28:-comment(author,"CrossCore Optimization Ltd").
29:-comment(copyright,"2007, CrossCore Optimization Ltd").
30:-comment(status,prototype).
31:-comment(date,"2006-2007").
32
33:-lib(eplex).
34:-lib(hash).
35:-lib(graph_algorithms).
36
37
38:-export(max_flow_eplex/5).
39:-comment(max_flow_eplex/5,
40          [
41              summary:"Linear programming solution for maximum flow problem",
42              amode:max_flow_eplex(+,+,+,+,-),
43              args:[
44                       "Graph": "a graph structure, no parallel edges,"
45                                " e(Src,Dest,EdgeData)", 
46                       "CapacityArg": "which argument of EdgeData to use as"
47                                      " edge capacity (integer), (0 if"
48                                      " EdgeData is a single number and -1"
49                                      " if every edge capacity is 1)",
50                       "SourceNode": "source node number (integer)",
51                       "SinkNode": "sink node number (integer)",
52                       "MaxFlowValue": "value of the maximum flow"
53                   ],
54              see_also:[max_flow:max_flow/5,
55                        max_flow:max_flow/7,
56                        max_flow_eplex:max_flow_eplex/5,
57                        max_flow_eplex:max_flow_eplex_dual/5,
58                        max_flow_eplex:max_flow_eplex_dual/7,
59                        all_min_cuts:all_min_cuts/8,
60                        all_min_cuts:all_min_cuts/9,
61                        all_min_cuts:all_min_cuts_list/5,
62                        all_min_cuts_eplex:all_min_cuts_eplex/7,
63                        all_min_cuts_eplex:all_min_cuts_eplex/8
64                       ]
65          ]
66         ).
67
68:-export(max_flow_eplex_dual/5).
69:-comment(max_flow_eplex_dual/5,
70          [
71              summary:"Linear programming solution for maximum flow problem,"
72                      " dual linear program",
73              amode:max_flow_eplex_dual(+,+,+,+,-),
74              args:[
75                       "Graph": "a graph structure, no parallel edges,"
76                                " e(Src,Dest,EdgeData)", 
77                       "CapacityArg": "which argument of EdgeData to use as"
78                                      " edge capacity (integer), (0 if"
79                                      " EdgeData is a single number and -1"
80                                      " if every edge capacity is 1)",
81                       "SourceNode": "source node number (integer)",
82                       "SinkNode": "sink node number (integer)",
83                       "MaxFlowValue": "value of the maximum flow"
84                   ],
85              see_also:[max_flow:max_flow/5,
86                        max_flow:max_flow/7,
87                        max_flow_eplex:max_flow_eplex/5,
88                        max_flow_eplex:max_flow_eplex_dual/5,
89                        max_flow_eplex:max_flow_eplex_dual/7,
90                        all_min_cuts:all_min_cuts/8,
91                        all_min_cuts:all_min_cuts/9,
92                        all_min_cuts:all_min_cuts_list/5,
93                        all_min_cuts_eplex:all_min_cuts_eplex/7,
94                        all_min_cuts_eplex:all_min_cuts_eplex/8
95                       ]
96          ]
97         ).
98
99
100:-export(max_flow_eplex_dual/7).
101:-comment(max_flow_eplex_dual/7,
102          [
103              summary:"Linear programming solution for maximum flow problem,"
104                      " dual linear program. Outputs the cut as nodes and"
105                      " edges.",
106              amode:max_flow_eplex_dual(+,+,+,+,-,-,-),
107              args:[
108                       "Graph": "a graph structure, no parallel edges,"
109                                " e(Src,Dest,EdgeData)", 
110                       "CapacityArg": "which argument of EdgeData to use as"
111                                      " edge capacity (integer), (0 if"
112                                      " EdgeData is a single number and -1"
113                                      " if every edge capacity is 1)",
114                       "SourceNode": "source node number (integer)",
115                       "SinkNode": "sink node number (integer)",
116                       "MaxFlowValue": "value of the maximum flow",
117                       "MinCutNodes": "List of nodes that belong to the"
118                                      " source side of the minimum cost cut",
119                       "MinCutEdges": "List of edges of the minimum cost cut"
120                       ],
121              see_also:[max_flow:max_flow/5,
122                        max_flow:max_flow/7,
123                        max_flow_eplex:max_flow_eplex/5,
124                        max_flow_eplex:max_flow_eplex_dual/5,
125                        max_flow_eplex:max_flow_eplex_dual/7,
126                        all_min_cuts:all_min_cuts/8,
127                        all_min_cuts:all_min_cuts/9,
128                        all_min_cuts:all_min_cuts_list/5,
129                        all_min_cuts_eplex:all_min_cuts_eplex/7,
130                        all_min_cuts_eplex:all_min_cuts_eplex/8
131                       ]
132          ]
133         ).
134
135max_flow_eplex(Graph,CapacityArg,SourceNode,SinkNode,MaxFlowValue):-
136        eplex: eplex_solver_setup(max(X_ts)),
137
138        % circular model, we add a dummy edge from sink t to source s with
139        % infinite capacity
140        
141        % maximize the flow on this t-s edge
142        
143        define_vars(Graph,CapacityArg,SourceNode,SinkNode,EdgeVars,X_ts),
144        
145        flow_constraints(Graph,SourceNode,SinkNode,EdgeVars),
146        eplex: eplex_solve(MaxFlowValue),
147        eplex: eplex_cleanup.
148
149
150
151define_vars(Graph,CapacityArg,SourceNode,SinkNode,EdgeVars,X_ts):-
152
153        % define edge variables and their capacity bounds
154        
155        graph_get_all_edges(Graph,Edges),
156        hash_create(EdgeVars),        
157        (
158            foreach(e(S,D,Info),Edges),
159            param(EdgeVars,CapacityArg)
160        do
161            capacity(CapacityArg,Info,Capacity),
162            eplex: (X $>= 0),
163            eplex: (X $=< Capacity),
164            hash_add(EdgeVars,key(S,D),X)
165        ),
166        
167        % dummy t-s edge variable with infinite capacity bound
168        eplex: (X_ts $>= 0),
169        (
170            hash_get(EdgeVars,key(SinkNode,SourceNode),_)
171        ->
172            %% there is already t-s edge, replace it
173            hash_set(EdgeVars,key(SinkNode,SourceNode),X_ts)
174        ;
175            hash_add(EdgeVars,key(SinkNode,SourceNode),X_ts)
176        ).
177        
178        
179capacity(-1,_EdgeInfo,1):-!.
180capacity(0,EdgeInfo,EdgeInfo):-!.
181capacity(CapacityArg,EdgeInfo,Capacity):-
182        CapacityArg > 0,
183        !,
184        arg(CapacityArg,EdgeInfo,Capacity).
185capacity(_,_,_):-!,fail.
186
187       
188             
189flow_constraints(Graph,SourceNode,SinkNode,EdgeVars):-
190        graph_get_maxnode(Graph,N),
191        (
192            for(I,1,N),
193            param(Graph,SourceNode,SinkNode,EdgeVars)
194        do
195            get_out_edges(Graph,SourceNode,SinkNode,I,OutEdges),
196            (
197                foreach(e(_,J,_),OutEdges),
198                foreach(X_ij,X_ijs),
199                param(I,EdgeVars)
200            do
201                hash_get(EdgeVars,key(I,J),X_ij)
202            ),
203            get_in_edges(Graph,SourceNode,SinkNode,I,InEdges),
204            (
205                foreach(e(J,_,_),InEdges),
206                foreach(X_ji,X_jis),
207                param(I,EdgeVars)
208            do
209                hash_get(EdgeVars,key(J,I),X_ji)
210            ),
211            eplex: (sum(X_ijs) $= sum(X_jis))
212        ).
213
214get_out_edges(Graph,SourceNode,SinkNode,I,OutEdges):-
215        graph_get_adjacent_edges(Graph,I,OutEdges1),
216        (
217            I == SinkNode,
218            not memberchk(e(SinkNode,SourceNode,_),OutEdges1)
219        ->
220            OutEdges = [e(SinkNode,SourceNode,_)|OutEdges1]
221        ;
222            OutEdges = OutEdges1
223        ).
224              
225            
226get_in_edges(Graph,SourceNode,SinkNode,I,InEdges):-
227        graph_get_incoming_edges(Graph,I,InEdges1),
228        (
229            I == SourceNode,
230            not memberchk(e(SinkNode,SourceNode,_),InEdges1)
231        ->
232            InEdges = [e(SinkNode,SourceNode,_)|InEdges1]
233        ;
234            InEdges = InEdges1
235        ).
236            
237
238
239max_flow_eplex_dual(Graph,CapacityArg,SourceNode,SinkNode,MaxFlowValue):- 
240        
241        max_flow_eplex_dual_core(Graph,CapacityArg,SourceNode,SinkNode,
242                                 MaxFlowValue, 
243                                 _NodeVars,_EdgeVars),
244        eplex: eplex_cleanup.
245        
246 
247max_flow_eplex_dual(Graph,CapacityArg,SourceNode,SinkNode,MaxFlowValue,
248                    MinCutNodes,MinCutEdges):-  
249        
250        max_flow_eplex_dual_core(Graph,CapacityArg,SourceNode,SinkNode,
251                                 MaxFlowValue, 
252                                 NodeVars,EdgeVars),
253 
254        output_cut(Graph,NodeVars,EdgeVars,MinCutNodes,MinCutEdges),
255        eplex: eplex_cleanup.
256
257
258max_flow_eplex_dual_core(Graph,CapacityArg,SourceNode,SinkNode,MaxFlowValue,
259                    NodeVars,EdgeVars):- 
260        eplex: eplex_solver_setup(min(ObjFn)),
261
262        dual_model(Graph,CapacityArg,SourceNode,SinkNode,NodeVars,
263                   EdgeVars,ObjFn), 
264        eplex: eplex_solve(MaxFlowValue).
265
266        
267dual_model(Graph,CapacityArg,SourceNode,SinkNode,NodeVars,
268           EdgeVars,ObjFn):-
269        
270        graph_get_maxnode(Graph,N),
271        dim(NodeVars,[N]),
272        (
273            foreacharg(Y,NodeVars)
274        do
275            eplex: (Y $>= 0),
276            eplex: (Y $=< 1)
277        ),
278        
279        graph_get_all_edges(Graph,Edges),
280        hash_create(EdgeVars),        
281        (
282            foreach(e(I,J,Info),Edges),
283            foreach(Z,EdgeVarList),
284            foreach(Capacity,EdgeCapacityList),
285            param(EdgeVars,CapacityArg,NodeVars)
286        do
287            eplex: (Z $>= 0),
288            eplex: (Z $=< 1),
289            hash_add(EdgeVars,key(I,J),Z),
290            
291            capacity(CapacityArg,Info,Capacity),
292            
293            arg(I,NodeVars,Y_i),
294            arg(J,NodeVars,Y_j),
295            eplex: (Y_i - Y_j + Z $>= 0)
296
297        ),
298        
299        arg(SourceNode,NodeVars,X_s),
300        arg(SinkNode,NodeVars,X_t),
301        eplex: ( X_s $= 0 ),
302        eplex: ( X_t $= 1 ),
303             
304        eplex: (ObjFn $= EdgeCapacityList * EdgeVarList).
305        
306        
307output_cut(Graph,NodeVars,EdgeVars,MinCutNodes,MinCutEdges):-
308        (
309            count(I,1,_),
310            foreacharg(Y,NodeVars),
311            fromto([],In,Out,MinCutNodes)
312        do
313            eplex: eplex_var_get(Y,typed_solution,Sol),
314            (
315                ( Sol == 0.0 ; Sol = -0.0 )
316            -> 
317                Out = [I|In]
318            ;
319                Out = In
320            )
321        ),
322
323        hash_list(EdgeVars,EdgeKeys,EdgeVarsList),
324        (
325            foreach(key(I,J),EdgeKeys),
326            foreach(Z,EdgeVarsList),
327            fromto([],In,Out,MinCutEdges),
328            param(Graph)
329        do
330            eplex: eplex_var_get(Z,typed_solution,Sol),
331            (
332                Sol == 1.0
333            -> 
334                graph_get_edge(Graph,I,J,Edge),
335                Out = [Edge|In]
336            ;
337                Out = In
338            )
339        ).
340