/* $Id$ Part of SWI-Prolog Author: Markus Triska E-mail: triska@gmx.at WWW: http://www.swi-prolog.org Copyright (C): 2005-2009, Markus Triska This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA As a special exception, if you link this library with other files, compiled with a Free Software compiler, to produce an executable, this library does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU General Public License. */ :- module(simplex, [ assignment/2, constraint/3, constraint/4, constraint_add/4, gen_state/1, gen_state_clpr/1, gen_state_clpr/2, maximize/3, minimize/3, objective/2, shadow_price/3, transportation/4, variable_value/3 ]). :- use_module(library(clpr)). :- use_module(library(assoc)). :- use_module(library(pio)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CLP(R) bindings the (unsolved) state is stored as a structure of the form clpr_state(Options, Cs, Is) Options: list of Option=Value pairs, currently only eps=Eps Cs: list of constraints, i.e., structures of the form c(Name, Left, Op, Right) anonymous constraints have Name == 0 Is: list of integral variables - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ gen_state_clpr(State) :- gen_state_clpr([], State). gen_state_clpr(Options, State) :- ( memberchk(eps=_, Options) -> Options1 = Options ; Options1 = [eps=1e-6|Options] ), State = clpr_state(Options1, [], []). clpr_state_options(clpr_state(Os, _, _), Os). clpr_state_constraints(clpr_state(_, Cs, _), Cs). clpr_state_integrals(clpr_state(_, _, Is), Is). clpr_state_add_integral(I, clpr_state(Os, Cs, Is), clpr_state(Os, Cs, [I|Is])). clpr_state_add_constraint(C, clpr_state(Os, Cs, Is), clpr_state(Os, [C|Cs], Is)). clpr_state_set_constraints(Cs, clpr_state(Os,_,Is), clpr_state(Os, Cs, Is)). clpr_constraint(Name, Constraint, S0, S) :- ( Constraint = integral(Var) -> clpr_state_add_integral(Var, S0, S) ; Constraint =.. [Op,Left,Right], coeff_one(Left, Left1), clpr_state_add_constraint(c(Name, Left1, Op, Right), S0, S) ). clpr_constraint(Constraint, S0, S) :- clpr_constraint(0, Constraint, S0, S). clpr_shadow_price(clpr_solved(_,_,Duals,_), Name, Value) :- memberchk(Name-Value0, Duals), Value is Value0. %( var(Value0) -> % Value = 0 %; % Value is Value0 %). clpr_make_variables(Cs, Aliases) :- clpr_constraints_variables(Cs, Variables0, []), sort(Variables0, Variables1), clpr_aliases(Variables1, Aliases). clpr_constraints_variables([]) --> []. clpr_constraints_variables([c(_, Left, _, _)|Cs]) --> variables(Left), clpr_constraints_variables(Cs). clpr_aliases([], []). clpr_aliases([Var|Vars], [Var-_|Rest]) :- clpr_aliases(Vars, Rest). clpr_set_up([], _). clpr_set_up([C|Cs], Aliases) :- C = c(_Name, Left, Op, Right), clpr_translate_linsum(Left, Aliases, LinSum), CLPRConstraint =.. [Op, LinSum, Right], clpr:{ CLPRConstraint }, clpr_set_up(Cs, Aliases). clpr_set_up_noneg([], _). clpr_set_up_noneg([Var|Vs], Aliases) :- memberchk(Var-CLPVar, Aliases), { CLPVar >= 0 }, clpr_set_up_noneg(Vs, Aliases). clpr_translate_linsum([], _, 0). clpr_translate_linsum([Coeff*Var|Ls], Aliases, LinSum) :- memberchk(Var-CLPVar, Aliases), LinSum = Coeff*CLPVar + LinRest, clpr_translate_linsum(Ls, Aliases, LinRest). clpr_dual(Objective0, S0, DualValues) :- clpr_state_constraints(S0, Cs0), clpr_constraints_variables(Cs0, Variables0, []), sort(Variables0, Variables1), clpr_standard_form(Cs0, Cs1), clpr_include_all_vars(Cs1, Variables1, Cs2), clpr_merge_into(Variables1, Objective0, Objective, []), clpr_unique_names(Cs2, 0, Names), clpr_constraints_coefficients(Cs2, Coefficients), transpose(Coefficients, TCs), clpr_dual_constraints(TCs, Objective, Names, DualConstraints), clpr_nonneg_constraints(Cs2, Names, DualNonNeg, []), append(DualConstraints, DualNonNeg, DualConstraints1), clpr_dual_objective(Cs2, Names, DualObjective), clpr_make_variables(DualConstraints1, Aliases), clpr_set_up(DualConstraints1, Aliases), clpr_translate_linsum(DualObjective, Aliases, LinExpr), minimize(LinExpr), Aliases = DualValues. clpr_dual_objective([], _, []). clpr_dual_objective([C|Cs], [Name|Names], [Right*Name|Os]) :- C = c(_, _, _, Right), clpr_dual_objective(Cs, Names, Os). clpr_nonneg_constraints([], _, Nons, Nons). clpr_nonneg_constraints([C|Cs], [Name|Names], Nons0, Nons) :- C = c(_, _, Op, _), ( Op == (=<) -> Nons0 = [c(0, [1*Name], (>=), 0)|Rest] ; Nons0 = Rest ), clpr_nonneg_constraints(Cs, Names, Rest, Nons). clpr_dual_constraints([], [], _, []). clpr_dual_constraints([Coeffs|Cs], [O*_|Os], Names, [Constraint|Constraints]) :- clpr_dual_linsum(Coeffs, Names, Linsum), Constraint = c(0, Linsum, (>=), O), clpr_dual_constraints(Cs, Os, Names, Constraints). clpr_dual_linsum([], [], []). clpr_dual_linsum([Coeff|Coeffs], [Name|Names], [Coeff*Name|Rest]) :- clpr_dual_linsum(Coeffs, Names, Rest). clpr_constraints_coefficients([], []). clpr_constraints_coefficients([C|Cs], [Coeff|Coeffs]) :- C = c(_, Left, _, _), all_coeffs(Left, Coeff), clpr_constraints_coefficients(Cs, Coeffs). all_coeffs([], []). all_coeffs([Coeff*_|Cs], [Coeff|Rest]) :- all_coeffs(Cs, Rest). clpr_unique_names([], _, []). clpr_unique_names([C0|Cs0], Num, [N|Ns]) :- C0 = c(Name, _, _, _), ( Name == 0 -> N = Num, Num1 is Num + 1 ; N = Name, Num1 = Num ), clpr_unique_names(Cs0, Num1, Ns). clpr_include_all_vars([], _, []). clpr_include_all_vars([C0|Cs0], Variables, [C|Cs]) :- C0 = c(Name, Left0, Op, Right), clpr_merge_into(Variables, Left0, Left, []), C = c(Name, Left, Op, Right), clpr_include_all_vars(Cs0, Variables, Cs). clpr_merge_into([], _, Ls, Ls). clpr_merge_into([V|Vs], Left, Ls0, Ls) :- ( member(Coeff*V, Left) -> Ls0 = [Coeff*V|Rest] ; Ls0 = [0*V|Rest] ), clpr_merge_into(Vs, Left, Rest, Ls). clpr_maximize(Expr0, S0, S) :- coeff_one(Expr0, Expr), clpr_state_constraints(S0, Cs), clpr_make_variables(Cs, Aliases), clpr_set_up(Cs, Aliases), clpr_constraints_variables(Cs, Variables0, []), sort(Variables0, Variables1), clpr_set_up_noneg(Variables1, Aliases), clpr_translate_linsum(Expr, Aliases, LinExpr), clpr_state_integrals(S0, Is), ( Is == [] -> maximize(LinExpr), Sup is LinExpr, clpr_dual(Expr, S0, DualValues), S = clpr_solved(Sup, Aliases, DualValues, S0) ; clpr_state_options(S0, Options), memberchk(eps=Eps, Options), clpr_fetch_vars(Is, Aliases, Vars), bb_inf(Vars, -LinExpr, Sup, Vertex, Eps), clpr_merge_vars(Is, Vertex, Values), % what about the dual in MIPs? Sup1 is -Sup, S = clpr_solved(Sup1, Values, [], S0) ). clpr_minimize(Expr0, S0, S) :- coeff_one(Expr0, Expr1), clpr_all_negate(Expr1, Expr2), clpr_maximize(Expr2, S0, S1), S1 = clpr_solved(Sup, Values, Duals, S0), Inf is -Sup, S = clpr_solved(Inf, Values, Duals, S0). clpr_merge_vars([], [], []). clpr_merge_vars([I|Is], [V|Vs], [I-V|Rest]) :- clpr_merge_vars(Is, Vs, Rest). clpr_fetch_vars([], _, []). clpr_fetch_vars([Var|Vars], Aliases, [X|Xs]) :- memberchk(Var-X, Aliases), clpr_fetch_vars(Vars, Aliases, Xs). clpr_variable_value(clpr_solved(_, Aliases, _, _), Variable, Value) :- memberchk(Variable-Value0, Aliases), Value is Value0. %( var(Value0) -> % Value = 0 %; % Value is Value0 %). clpr_objective(clpr_solved(Obj, _, _, _), Obj). clpr_standard_form([], []). clpr_standard_form([c(Name, Left, Op, Right)|Cs], [S|Ss]) :- clpr_standard_form_(Op, Name, Left, Right, S), clpr_standard_form(Cs, Ss). clpr_standard_form_((=), Name, Left, Right, c(Name, Left, (=), Right)). clpr_standard_form_((>=), Name, Left, Right, c(Name, Left1, (=<), Right1)) :- Right1 is -Right, clpr_all_negate(Left, Left1). clpr_standard_form_((=<), Name, Left, Right, c(Name, Left, (=<), Right)). clpr_all_negate([], []). clpr_all_negate([Coeff0*Var|As], [Coeff1*Var|Ns]) :- Coeff1 is -Coeff0, clpr_all_negate(As, Ns). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - General Simplex Algorithm Structures used: tableau(Objective, Variables, Indicators, Constraints) *) objective function, represented as row *) list of variables corresponding to columns *) indicators denoting which variables are still active *) constraints as rows row(Var, Left, Right) *) the basic variable corresponding to this row *) coefficients of the left-hand side of the constraint *) right-hand side of the constraint - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ find_row(Variable, [Row|Rows], R) :- Row = row(V, _, _), ( V == Variable -> R = Row ; find_row(Variable, Rows, R) ). variable_value(State, Variable, Value) :- functor(State, F, _), ( F == solved -> solved_tableau(State, Tableau), tableau_rows(Tableau, Rows), ( find_row(Variable, Rows, Row) -> Row = row(_, _, Value) ; Value = 0 ) ; F == clpr_solved -> clpr_variable_value(State, Variable, Value) ). all_vars_zero([], _). all_vars_zero([_Coeff*Var|Vars], State) :- variable_value(State, Var, 0), all_vars_zero(Vars, State). list_first(Ls, F, Index) :- once(nth0(Index, Ls, F)). shadow_price(State, Name, Value) :- functor(State, F, _), ( F == solved -> solved_tableau(State, Tableau), tableau_objective(Tableau, row(_,Left,_)), tableau_variables(Tableau, Variables), solved_names(State, Names), memberchk(user(Name)-Var, Names), list_first(Variables, Var, Nth0), nth0(Nth0, Left, Value) ; F == clpr_solved -> clpr_shadow_price(State, Name, Value) ). objective(State, Obj) :- functor(State, F, _), ( F == solved -> solved_tableau(State, Tableau), tableau_objective(Tableau, Objective), Objective = row(_, _, Obj) ; clpr_objective(State, Obj) ). % interface functions that access tableau components tableau_objective(tableau(Obj, _, _, _), Obj). tableau_rows(tableau(_, _, _, Rows), Rows). tableau_indicators(tableau(_, _, Inds, _), Inds). tableau_variables(tableau(_, Vars, _, _), Vars). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - interface functions that access and modify state components state is a structure of the form state(Num, Names, Cs, Is) Num: used to obtain new unique names for slack variables in a side-effect free way (increased by one and threaded through) Names: list of Name-Var, correspondence between constraint-names and names of slack/artificial variables to obtain shadow prices later Cs: list of constraints Is: list of integer variables constraints are initially represented as c(Name, Left, Op, Right), and after normalizing as c(Var, Left, Right). Name of unnamed constraints is 0. The distinction is important for merging constraints (mainly in branch and bound) with existing ones. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ constraint_name(c(Name, _, _, _), Name). constraint_op(c(_, _, Op, _), Op). constraint_left(c(_, Left, _, _), Left). constraint_right(c(_, _, _, Right), Right). gen_state(state(0,[],[],[])). state_add_constraint(C, S0, S) :- ( constraint_name(C, 0), constraint_left(C, [_Coeff*_Var]) -> state_merge_constraint(C, S0, S) ; state_add_constraint_(C, S0, S) ). state_add_constraint_(C, state(VID,Ns,Cs,Is), state(VID,Ns,[C|Cs],Is)). state_merge_constraint(C, S0, S) :- constraint_left(C, [Coeff0*Var0]), constraint_right(C, Right0), constraint_op(C, Op), ( Coeff0 =:= 0 -> ( Op == (=) -> Right0 =:= 0, S0 = S ; Op == (=<) -> S0 = S ; Op == (>=) -> Right0 =:= 0, S0 = S ) ; Coeff0 < 0 -> state_add_constraint_(C, S0, S) ; Right is Right0 rdiv Coeff0, state_constraints(S0, Cs), ( select(c(0, [1*Var0], Op, CRight), Cs, RestCs) -> ( Op == (=) -> CRight =:= Right, S0 = S ; Op == (=<) -> NewRight is min(Right, CRight), NewCs = [c(0, [1*Var0], Op, NewRight)|RestCs], state_set_constraints(NewCs, S0, S) ; Op == (>=) -> NewRight is max(Right, CRight), NewCs = [c(0, [1*Var0], Op, NewRight)|RestCs], state_set_constraints(NewCs, S0, S) ) ; state_add_constraint_(c(0, [1*Var0], Op, Right), S0, S) ) ). state_add_name(Name, Var), [state(VID,[Name-Var|Ns],Cs,Is)] --> [state(VID,Ns,Cs,Is)]. state_add_integral(Var, state(VID,Ns,Cs,Is), state(VID,Ns,Cs,[Var|Is])). state_constraints(state(_, _, Cs, _), Cs). state_names(state(_,Names,_,_), Names). state_integrals(state(_,_,_,Is), Is). state_set_constraints(Cs, state(VID,Ns,_,Is), state(VID,Ns,Cs,Is)). state_set_integrals(Is, state(VID,Ns,Cs,_), state(VID,Ns,Cs,Is)). state_next_var(VarID0), [state(VarID1,Names,Cs,Is)] --> [state(VarID0,Names,Cs,Is)], { VarID1 is VarID0 + 1 }. solved_tableau(solved(Tableau, _, _), Tableau). solved_names(solved(_, Names,_), Names). solved_integrals(solved(_,_,Is), Is). % User-named constraints are wrapped with user/1 to also allow "0" in % constraint names. constraint(C, S0, S) :- functor(S0, F, _), ( F == state -> ( C = integral(Var) -> state_add_integral(Var, S0, S) ; constraint_(0, C, S0, S) ) ; F == clpr_state -> clpr_constraint(C, S0, S) ). constraint(Name, C, S0, S) :- constraint_(user(Name), C, S0, S). constraint_(Name, C, S0, S) :- functor(S0, F, _), ( F == state -> ( C = integral(Var) -> state_add_integral(Var, S0, S) ; C =.. [Op, Left0, Right0], coeff_one(Left0, Left), Right0 >= 0, Right is rationalize(Right0), state_add_constraint(c(Name, Left, Op, Right), S0, S) ) ; F == clpr_state -> clpr_constraint(Name, C, S0, S) ). constraint_add(Name, A, S0, S) :- functor(S0, F, _), ( F == state -> state_constraints(S0, Cs), add_left(Cs, user(Name), A, Cs1), state_set_constraints(Cs1, S0, S) ; F == clpr_state -> clpr_state_constraints(S0, Cs), add_left(Cs, Name, A, Cs1), clpr_state_set_constraints(Cs1, S0, S) ). add_left([c(Name,Left0,Op,Right)|Cs], V, A, [c(Name,Left,Op,Right)|Rest]) :- ( Name == V -> append(A, Left0, Left), Rest = Cs ; Left0 = Left, add_left(Cs, V, A, Rest) ). branching_variable(State, Variable) :- solved_integrals(State, Integrals), member(Variable, Integrals), variable_value(State, Variable, Value), \+ integer(Value). worth_investigating(ZStar0, _, _) :- var(ZStar0). worth_investigating(ZStar0, AllInt, Z) :- nonvar(ZStar0), ( AllInt =:= 1 -> Z1 is floor(Z) ; Z1 = Z ), Z1 > ZStar0. branch_and_bound(Objective, Solved, AllInt, ZStar0, ZStar, S0, S, Found) :- objective(Solved, Z), ( worth_investigating(ZStar0, AllInt, Z) -> ( branching_variable(Solved, BrVar) -> variable_value(Solved, BrVar, Value), Value1 is floor(Value), Value2 is Value1 + 1, constraint([BrVar] =< Value1, S0, SubProb1), ( maximize_(Objective, SubProb1, SubSolved1) -> Sub1Feasible = 1, objective(SubSolved1, Obj1) ; Sub1Feasible = 0 ), constraint([BrVar] >= Value2, S0, SubProb2), ( maximize_(Objective, SubProb2, SubSolved2) -> Sub2Feasible = 1, objective(SubSolved2, Obj2) ; Sub2Feasible = 0 ), ( Sub1Feasible =:= 1, Sub2Feasible =:= 1 -> ( Obj1 >= Obj2 -> First = SubProb1, Second = SubProb2, FirstSolved = SubSolved1, SecondSolved = SubSolved2 ; First = SubProb2, Second = SubProb1, FirstSolved = SubSolved2, SecondSolved = SubSolved1 ), branch_and_bound(Objective, FirstSolved, AllInt, ZStar0, ZStar1, First, Solved1, Found1), branch_and_bound(Objective, SecondSolved, AllInt, ZStar1, ZStar2, Second, Solved2, Found2) ; Sub1Feasible =:= 1 -> branch_and_bound(Objective, SubSolved1, AllInt, ZStar0, ZStar1, SubProb1, Solved1, Found1), Found2 = 0 ; Sub2Feasible =:= 1 -> Found1 = 0, branch_and_bound(Objective, SubSolved2, AllInt, ZStar0, ZStar2, SubProb2, Solved2, Found2) ; Found1 = 0, Found2 = 0 ), ( Found1 =:= 1, Found2 =:= 1 -> S = Solved2, ZStar = ZStar2 ; Found1 =:= 1 -> S = Solved1, ZStar = ZStar1 ; Found2 =:= 1 -> S = Solved2, ZStar = ZStar2 ; S = S0, ZStar = ZStar0 ), Found is max(Found1, Found2) ; S = Solved, ZStar = Z, Found = 1 ) ; ZStar = ZStar0, S = S0, Found = 0 ). maximize(Z0, S0, S) :- coeff_one(Z0, Z1), functor(S0, F, _), ( F == state -> maximize_mip(Z1, S0, S) ; F == clpr_state -> clpr_maximize(Z1, S0, S) ). maximize_mip(Z, S0, S) :- maximize_(Z, S0, Solved), state_integrals(S0, Is), ( Is == [] -> S = Solved ; % arrange it so that branch and bound branches on variables % in the same order the integrality constraints were stated in reverse(Is, Is1), state_set_integrals(Is1, S0, S1), ( all_integers(Z, Is1) -> AllInt = 1 ; AllInt = 0 ), branch_and_bound(Z, Solved, AllInt, _, _, S1, S, 1) ). all_integers([], _). all_integers([Coeff*V|Rest], Is) :- integer(Coeff), memberchk(V, Is), all_integers(Rest, Is). minimize(Z0, S0, S) :- coeff_one(Z0, Z1), functor(S0, F, _), ( F == state -> linsum_negate(Z1, Z2), maximize_mip(Z2, S0, S1), solved_tableau(S1, tableau(Obj, Vars, Inds, Rows)), solved_names(S1, Names), Obj = row(z, Left0, Right0), all_times(Left0, -1, Left), Right is -Right0, Obj1 = row(z, Left, Right), state_integrals(S0, Is), S = solved(tableau(Obj1, Vars, Inds, Rows), Names, Is) ; F == clpr_state -> clpr_minimize(Z1, S0, S) ). op_pendant(>=, =<). op_pendant(=<, >=). constraints_collapse([], []). constraints_collapse([C|Cs], Colls) :- C = c(Name, Left, Op, Right), ( Name == 0, Left = [1*Var], op_pendant(Op, P) -> Pendant = c(0, [1*Var], P, Right), ( select(Pendant, Cs, Rest) -> Colls = [c(0, Left, (=), Right)|CollRest], CsLeft = Rest ; Colls = [C|CollRest], CsLeft = Cs ) ; Colls = [C|CollRest], CsLeft = Cs ), constraints_collapse(CsLeft, CollRest). % solve a (relaxed) LP in standard form maximize_(Z, S0, S) :- state_constraints(S0, Cs0), constraints_collapse(Cs0, Cs1), phrase(constraints_normalize(Cs1, Cs, As0), [S0], [S1]), flatten(As0, As1), ( As1 == [] -> make_tableau(Z, Cs, Tableau0), simplex(Tableau0, Tableau), state_names(S1, Names), state_integrals(S1, Is), S = solved(Tableau, Names, Is) ; state_names(S1, Names), state_integrals(S1, Is), two_phase_simplex(Z, Cs, As1, Names, Is, S) ). make_tableau(Z, Cs, Tableau) :- ZC = c(_, Z, _), phrase(constraints_variables([ZC|Cs]), Variables0), sort(Variables0, Variables), constraints_rows(Cs, Variables, Rows), linsum_row(Variables, Z, Objective1), all_times(Objective1, -1, Obj), length(Variables, LVs), length(Ones, LVs), all_one(Ones), Tableau = tableau(row(z, Obj, 0), Variables, Ones, Rows). all_one([]). all_one([1|Os]) :- all_one(Os). proper_form([], _, _, Obj, Obj). proper_form([_Coeff*A|As], Variables, Rows, Obj0, Obj) :- ( find_row(A, Rows, PivotRow) -> list_first(Variables, A, Col), row_eliminate(Obj0, PivotRow, Col, Obj1) ; Obj1 = Obj0 ), proper_form(As, Variables, Rows, Obj1, Obj). two_phase_simplex(Z, Cs, As, Names, Is, S) :- % phase 1: minimize sum of articifial variables make_tableau(As, Cs, Tableau0), Tableau0 = tableau(Obj0, Variables, Inds, Rows), proper_form(As, Variables, Rows, Obj0, Obj), simplex(tableau(Obj, Variables, Inds, Rows), Tableau1), all_vars_zero(As, solved(Tableau1, _, _)), % phase 2: remove artificial variables and solve actual LP. tableau_rows(Tableau1, Rows2), eliminate_artificial(As, As, Variables, Rows2, Rows3), list_nths(As, Variables, Nths0), nths_to_zero(Nths0, Inds, Inds1), linsum_row(Variables, Z, Objective), all_times(Objective, -1, Objective1), proper_form(Z, Variables, Rows3, row(z, Objective1, 0), ObjRow), simplex(tableau(ObjRow, Variables, Inds1, Rows3), Tableau), S = solved(Tableau, Names, Is). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - If artificial variables are still in the basis, replace them with non-artificial variables if possible. If that is not possible, the constraint is ignored because it is redundant. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ eliminate_artificial([], _, _, Rows, Rows). eliminate_artificial([_Coeff*A|Rest], As, Variables, Rows0, Rows) :- ( select(row(A, Left, 0), Rows0, Others) -> ( nth0(Col, Left, Coeff), Coeff =\= 0, nth0(Col, Variables, Var), \+ memberchk(_*Var, As) -> row_divide(row(A, Left, 0), Coeff, Row), gauss_elimination(Rows0, Row, Col, Rows1), swap_basic(Rows1, A, Var, Rows2) ; Rows2 = Others ) ; Rows2 = Rows0 ), eliminate_artificial(Rest, As, Variables, Rows2, Rows). nths_to_zero([], Inds, Inds). nths_to_zero([Nth|Nths], Inds0, Inds) :- nth_to_zero(Inds0, 0, Nth, Inds1), nths_to_zero(Nths, Inds1, Inds). nth_to_zero([], _, _, []). nth_to_zero([I|Is], Curr, Nth, [Z|Zs]) :- ( Curr =:= Nth -> [Z|Zs] = [0|Is] ; Z = I, Next is Curr + 1, nth_to_zero(Is, Next, Nth, Zs) ). list_nths([], _, []). list_nths([_Coeff*A|As], Variables, [Nth|Nths]) :- list_first(Variables, A, Nth), list_nths(As, Variables, Nths). linsum_negate([], []). linsum_negate([Coeff0*Var|Ls], [Coeff*Var|Ns]) :- Coeff is Coeff0 * (-1), linsum_negate(Ls, Ns). linsum_row([], _, []). linsum_row([V|Vs], Ls, [C|Cs]) :- ( member(Coeff*V, Ls) -> C is rationalize(Coeff) ; C = 0 ), linsum_row(Vs, Ls, Cs). constraints_rows([], _, []). constraints_rows([C|Cs], Vars, [R|Rs]) :- C = c(Var, Left0, Right), linsum_row(Vars, Left0, Left), R = row(Var, Left, Right), constraints_rows(Cs, Vars, Rs). constraints_normalize([], [], []) --> []. constraints_normalize([C0|Cs0], [C|Cs], [A|As]) --> { constraint_op(C0, Op), constraint_left(C0, Left), constraint_right(C0, Right), constraint_name(C0, Name), Con =.. [Op, Left, Right] }, constraint_normalize(Con, Name, C, A), constraints_normalize(Cs0, Cs, As). constraint_normalize(As0 =< B0, Name, c(Slack, [1*Slack|As0], B0), []) --> state_next_var(Slack), state_add_name(Name, Slack). constraint_normalize(As0 = B0, Name, c(AID, [1*AID|As0], B0), [-1*AID]) --> state_next_var(AID), state_add_name(Name, AID). constraint_normalize(As0 >= B0, Name, c(AID, [-1*Slack,1*AID|As0], B0), [-1*AID]) --> state_next_var(Slack), state_next_var(AID), state_add_name(Name, AID). coeff_one([], []). coeff_one([L|Ls], [Coeff*Var|Rest]) :- ( L = A*B -> Coeff = A, Var = B ; Coeff = 1, Var = L ), coeff_one(Ls, Rest). tableau_optimal(Tableau) :- tableau_objective(Tableau, Objective), tableau_indicators(Tableau, Indicators), Objective = row(_, Left, _), all_nonnegative(Left, Indicators). all_nonnegative([], []). all_nonnegative([Coeff|As], [I|Is]) :- ( I =:= 0 -> true ; Coeff >= 0 ), all_nonnegative(As, Is). pivot_column(Tableau, PCol) :- tableau_objective(Tableau, row(_, Left, _)), tableau_indicators(Tableau, Indicators), first_negative(Left, Indicators, 0, Index0, Val, RestL, RestI), Index1 is Index0 + 1, pivot_column(RestL, RestI, Val, Index1, Index0, PCol). first_negative([L|Ls], [I|Is], Index0, N, Val, RestL, RestI) :- Index1 is Index0 + 1, ( I =:= 0 -> first_negative(Ls, Is, Index1, N, Val, RestL, RestI) ; ( L < 0 -> N = Index0, Val = L, RestL = Ls, RestI = Is ; first_negative(Ls, Is, Index1, N, Val, RestL, RestI) ) ). pivot_column([], _, _, _, N, N). pivot_column([L|Ls], [I|Is], Coeff0, Index0, N0, N) :- ( I =:= 0 -> Coeff1 = Coeff0, N1 = N0 ; ( L < Coeff0 -> Coeff1 = L, N1 = Index0 ; Coeff1 = Coeff0, N1 = N0 ) ), Index1 is Index0 + 1, pivot_column(Ls, Is, Coeff1, Index1, N1, N). pivot_row(Tableau, PCol, PRow) :- tableau_rows(Tableau, Rows), pivot_row(Rows, PCol, false, _, 0, 0, PRow). pivot_row([], _, Bounded, _, _, Row, Row) :- Bounded. pivot_row([Row|Rows], PCol, Bounded0, Min0, Index0, PRow0, PRow) :- Row = row(_Var, Left, B), nth0(PCol, Left, Ae), ( Ae > 0 -> Bounded1 = true, Bound is B rdiv Ae, ( Bounded0 -> ( Bound < Min0 -> Min1 = Bound, PRow1 = Index0 ; Min1 = Min0, PRow1 = PRow0 ) ; Min1 = Bound, PRow1 = Index0 ) ; Bounded1 = Bounded0, Min1 = Min0, PRow1 = PRow0 ), Index1 is Index0 + 1, pivot_row(Rows, PCol, Bounded1, Min1, Index1, PRow1, PRow). row_divide(row(Var, Left0, Right0), Div, row(Var, Left, Right)) :- all_divide(Left0, Div, Left), Right is Right0 rdiv Div. all_divide([], _, []). all_divide([R|Rs], Div, [DR|DRs]) :- DR is R rdiv Div, all_divide(Rs, Div, DRs). gauss_elimination([], _, _, []). gauss_elimination([Row0|Rows0], PivotRow, Col, [Row|Rows]) :- PivotRow = row(PVar, _, _), Row0 = row(Var, _, _), ( PVar == Var -> Row = PivotRow ; row_eliminate(Row0, PivotRow, Col, Row) ), gauss_elimination(Rows0, PivotRow, Col, Rows). row_eliminate(row(Var, Ls0, R0), row(_, PLs, PR), Col, row(Var, Ls, R)) :- nth0(Col, Ls0, Coeff), ( Coeff =:= 0 -> Ls = Ls0, R = R0 ; MCoeff is -Coeff, all_times_plus([PR|PLs], MCoeff, [R0|Ls0], [R|Ls]) ). all_times_plus([], _, _, []). all_times_plus([A|As], T, [B|Bs], [AT|ATs]) :- AT is A * T + B, all_times_plus(As, T, Bs, ATs). all_times([], _, []). all_times([A|As], T, [AT|ATs]) :- AT is A * T, all_times(As, T, ATs). simplex(Tableau0, Tableau) :- ( tableau_optimal(Tableau0) -> Tableau0 = Tableau ; pivot_column(Tableau0, PCol), pivot_row(Tableau0, PCol, PRow), Tableau0 = tableau(Obj0,Variables,Inds,Matrix0), nth0(PRow, Matrix0, Row0), Row0 = row(Leaving, Left0, _Right0), nth0(PCol, Left0, PivotElement), row_divide(Row0, PivotElement, Row1), gauss_elimination([Obj0|Matrix0], Row1, PCol, [Obj|Matrix1]), nth0(PCol, Variables, Entering), swap_basic(Matrix1, Leaving, Entering, Matrix), simplex(tableau(Obj,Variables,Inds,Matrix), Tableau) ). swap_basic([Row0|Rows0], Old, New, Matrix) :- Row0 = row(Var, Left, Right), ( Var == Old -> Matrix = [row(New, Left, Right)|Rows0] ; Matrix = [Row0|Rest], swap_basic(Rows0, Old, New, Rest) ). constraints_variables([]) --> []. constraints_variables([c(_,Left,_)|Cs]) --> variables(Left), constraints_variables(Cs). variables([]) --> []. variables([_Coeff*Var|Rest]) --> [Var], variables(Rest). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - A dual algorithm ("algorithm alpha-beta" in Papadimitriou and Steiglitz) is used for transportation and assignment problems. The arising max-flow problem is solved with Edmonds-Karp, itself a dual algorithm. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - An attributed variable is introduced for each node. Attributes: node: Original name of the node. edges: arc_to(To,F,Capacity) (F has an attribute "flow") or arc_from(From,F,Capacity) parent: used in breadth-first search - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ arcs([], Assoc, Assoc). arcs([arc(From0,To0,C)|As], Assoc0, Assoc) :- ( get_assoc(From0, Assoc0, From) -> Assoc1 = Assoc0 ; put_assoc(From0, Assoc0, From, Assoc1), put_attr(From, node, From0) ), ( get_attr(From, edges, Es) -> true ; Es = [] ), put_attr(F, flow, 0), put_attr(From, edges, [arc_to(To,F,C)|Es]), ( get_assoc(To0, Assoc1, To) -> Assoc2 = Assoc1 ; put_assoc(To0, Assoc1, To, Assoc2), put_attr(To, node, To0) ), ( get_attr(To, edges, Es1) -> true ; Es1 = [] ), put_attr(To, edges, [arc_from(From,F,C)|Es1]), arcs(As, Assoc2, Assoc). edmonds_karp(Arcs0, Arcs) :- empty_assoc(E), arcs(Arcs0, E, Assoc), get_assoc(s, Assoc, S), get_assoc(t, Assoc, T), maximum_flow(S, T), % fetch attvars before deleting visited edges term_attvars(S, AttVars), phrase(flow_to_arcs(S), Ls), arcs_assoc(Ls, Arcs), maplist(del_attrs, AttVars). flow_to_arcs(V) --> ( { get_attr(V, edges, Es) } -> { del_attr(V, edges), get_attr(V, node, Name) }, flow_to_arcs_(Es, Name) ; [] ). flow_to_arcs_([], _) --> []. flow_to_arcs_([E|Es], Name) --> edge_to_arc(E, Name), flow_to_arcs_(Es, Name). edge_to_arc(arc_from(_,_,_), _) --> []. edge_to_arc(arc_to(To,F,C), Name) --> { get_attr(To, node, NTo), get_attr(F, flow, Flow) }, [arc(Name,NTo,Flow,C)], flow_to_arcs(To). arcs_assoc(Arcs, Hash) :- empty_assoc(E), arcs_assoc(Arcs, E, Hash). arcs_assoc([], Hs, Hs). arcs_assoc([arc(From,To,F,C)|Rest], Hs0, Hs) :- ( get_assoc(From, Hs0, As) -> Hs1 = Hs0 ; put_assoc(From, Hs0, [], Hs1), empty_assoc(As) ), put_assoc(To, As, arc(From,To,F,C), As1), put_assoc(From, Hs1, As1, Hs2), arcs_assoc(Rest, Hs2, Hs). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Strategy: Breadth-first search until we find a free right vertex in the value graph, then find an augmenting path in reverse. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ maximum_flow(S, T) :- ( augmenting_path([[S]], Levels, T) -> phrase(augmenting_path(S, T), Path), Path = [augment(_,First,_)|Rest], path_minimum(Rest, First, Min), % format("augmenting path: ~w\n", [Min]), maplist(augment(Min), Path), maplist(maplist(clear_parent), Levels), maximum_flow(S, T) ; true ). clear_parent(V) :- del_attr(V, parent). augmenting_path(Levels0, Levels, T) :- Levels0 = [Vs|_], Levels1 = [Tos|Levels0], phrase(reachables(Vs), Tos), Tos = [_|_], ( member(To, Tos), To == T -> Levels = Levels1 ; augmenting_path(Levels1, Levels, T) ). reachables([]) --> []. reachables([V|Vs]) --> { get_attr(V, edges, Es) }, reachables_(Es, V), reachables(Vs). reachables_([], _) --> []. reachables_([E|Es], V) --> reachable(E, V), reachables_(Es, V). reachable(arc_from(V,F,_), P) --> ( { \+ get_attr(V, parent, _), get_attr(F, flow, Flow), Flow > 0 } -> { put_attr(V, parent, P-augment(F,Flow,-)) }, [V] ; [] ). reachable(arc_to(V,F,C), P) --> ( { \+ get_attr(V, parent, _), get_attr(F, flow, Flow), ( C == inf ; Flow < C )} -> { ( C == inf -> Diff = inf ; Diff is C - Flow ), put_attr(V, parent, P-augment(F,Diff,+)) }, [V] ; [] ). path_minimum([], Min, Min). path_minimum([augment(_,A,_)|As], Min0, Min) :- ( A == inf -> Min1 = Min0 ; Min1 is min(Min0,A) ), path_minimum(As, Min1, Min). augment(Min, augment(F,_,Sign)) :- get_attr(F, flow, Flow0), flow_(Sign, Flow0, Min, Flow), put_attr(F, flow, Flow). flow_(+, F0, A, F) :- F is F0 + A. flow_(-, F0, A, F) :- F is F0 - A. augmenting_path(S, V) --> ( { V == S } -> [] ; { get_attr(V, parent, V1-Augment) }, [Augment], augmenting_path(S, V1) ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% naive_init(Supplies, _, Costs, Alphas, Betas) :- length(Supplies, LAs), length(Alphas, LAs), maplist(=(0), Alphas), transpose(Costs, TCs), naive_init_betas(TCs, Betas). naive_init_betas([], []). naive_init_betas([Ls|Lss], [B|Bs]) :- list_min(Ls, B), naive_init_betas(Lss, Bs). list_min([F|Rest], Min) :- list_min(Rest, F, Min). list_min([], Min, Min). list_min([L|Ls], Min0, Min) :- Min1 is min(L,Min0), list_min(Ls, Min1, Min). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% transpose(Ms, Ts) :- Ms = [F|_], transpose(F, Ms, Ts). transpose([], _, []). transpose([_|Rs], Ms, [Ts|Tss]) :- lists_firsts_rests(Ms, Ts, Ms1), transpose(Rs, Ms1, Tss). lists_firsts_rests([], [], []). lists_firsts_rests([[F|Os]|Rest], [F|Fs], [Os|Oss]) :- lists_firsts_rests(Rest, Fs, Oss). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TODO: use attributed variables throughout - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ transportation(Supplies, Demands, Costs, Transport) :- length(Supplies, LAs), length(Demands, LBs), naive_init(Supplies, Demands, Costs, Alphas, Betas), network_head(Supplies, 1, SArcs, []), network_tail(Demands, 1, DArcs, []), numlist(1, LAs, Sources), numlist(1, LBs, Sinks0), maplist(make_sink, Sinks0, Sinks), append(SArcs, DArcs, Torso), alpha_beta(Torso, Sources, Sinks, Costs, Alphas, Betas, Flow), flow_transport(Supplies, 1, Demands, Flow, Transport). flow_transport([], _, _, _, []). flow_transport([_|Rest], N, Demands, Flow, [Line|Lines]) :- transport_line(Demands, N, 1, Flow, Line), N1 is N + 1, flow_transport(Rest, N1, Demands, Flow, Lines). transport_line([], _, _, _, []). transport_line([_|Rest], I, J, Flow, [L|Ls]) :- ( get_assoc(I, Flow, As), get_assoc(p(J), As, arc(I,p(J),F,_)) -> L = F ; L = 0 ), J1 is J + 1, transport_line(Rest, I, J1, Flow, Ls). make_sink(N, p(N)). network_head([], _) --> []. network_head([S|Ss], N) --> [arc(s,N,S)], { N1 is N + 1 }, network_head(Ss, N1). network_tail([], _) --> []. network_tail([D|Ds], N) --> [arc(p(N),t,D)], { N1 is N + 1 }, network_tail(Ds, N1). network_connections([], _, _, _) --> []. network_connections([A|As], Betas, [Cs|Css], N) --> network_connections(Betas, Cs, A, N, 1), { N1 is N + 1 }, network_connections(As, Betas, Css, N1). network_connections([], _, _, _, _) --> []. network_connections([B|Bs], [C|Cs], A, N, PN) --> ( { C =:= A + B } -> [arc(N,p(PN),inf)] ; [] ), { PN1 is PN + 1 }, network_connections(Bs, Cs, A, N, PN1). alpha_beta(Torso, Sources, Sinks, Costs, Alphas, Betas, Flow) :- network_connections(Alphas, Betas, Costs, 1, Cons, []), append(Torso, Cons, Arcs), edmonds_karp(Arcs, MaxFlow), mark_hashes(MaxFlow, MArcs, MRevArcs), all_markable(MArcs, MRevArcs, Markable), mark_unmark(Sources, Markable, MarkSources, UnmarkSources), ( MarkSources == [] -> Flow = MaxFlow ; mark_unmark(Sinks, Markable, MarkSinks0, UnmarkSinks0), maplist(un_p, MarkSinks0, MarkSinks), maplist(un_p, UnmarkSinks0, UnmarkSinks), MarkSources = [FirstSource|_], UnmarkSinks = [FirstSink|_], theta(FirstSource, FirstSink, Costs, Alphas, Betas, TInit), theta(MarkSources, UnmarkSinks, Costs, Alphas, Betas, TInit, Theta), duals_add(MarkSources, Alphas, Theta, Alphas1), duals_add(UnmarkSinks, Betas, Theta, Betas1), Theta1 is -Theta, duals_add(UnmarkSources, Alphas1, Theta1, Alphas2), duals_add(MarkSinks, Betas1, Theta1, Betas2), alpha_beta(Torso, Sources, Sinks, Costs, Alphas2, Betas2, Flow) ). mark_hashes(MaxFlow, Arcs, RevArcs) :- assoc_to_list(MaxFlow, FlowList), maplist(un_arc, FlowList, FlowList1), flatten(FlowList1, FlowList2), empty_assoc(E), mark_arcs(FlowList2, E, Arcs), mark_revarcs(FlowList2, E, RevArcs). un_arc(_-Ls0, Ls) :- assoc_to_list(Ls0, Ls1), maplist(un_arc_, Ls1, Ls). un_arc_(_-Ls, Ls). mark_arcs([], Arcs, Arcs). mark_arcs([arc(From,To,F,C)|Rest], Arcs0, Arcs) :- ( get_assoc(From, Arcs0, As) -> true ; As = [] ), ( C == inf -> As1 = [To|As] ; F < C -> As1 = [To|As] ; As1 = As ), put_assoc(From, Arcs0, As1, Arcs1), mark_arcs(Rest, Arcs1, Arcs). mark_revarcs([], Arcs, Arcs). mark_revarcs([arc(From,To,F,_)|Rest], Arcs0, Arcs) :- ( get_assoc(To, Arcs0, Fs) -> true ; Fs = [] ), ( F > 0 -> Fs1 = [From|Fs] ; Fs1 = Fs ), put_assoc(To, Arcs0, Fs1, Arcs1), mark_revarcs(Rest, Arcs1, Arcs). un_p(p(N), N). duals_add([], Alphas, _, Alphas). duals_add([S|Ss], Alphas0, Theta, Alphas) :- add_to_nth(1, S, Alphas0, Theta, Alphas1), duals_add(Ss, Alphas1, Theta, Alphas). add_to_nth(N, N, [A0|As], Theta, [A|As]) :- !, A is A0 + Theta. add_to_nth(N0, N, [A|As0], Theta, [A|As]) :- N1 is N0 + 1, add_to_nth(N1, N, As0, Theta, As). theta(Source, Sink, Costs, Alphas, Betas, Theta) :- nth1(Source, Costs, Row), nth1(Sink, Row, C), nth1(Source, Alphas, A), nth1(Sink, Betas, B), Theta is (C - A - B) rdiv 2. theta([], _, _, _, _, Theta, Theta). theta([Source|Sources], Sinks, Costs, Alphas, Betas, Theta0, Theta) :- theta_(Sinks, Source, Costs, Alphas, Betas, Theta0, Theta1), theta(Sources, Sinks, Costs, Alphas, Betas, Theta1, Theta). theta_([], _, _, _, _, Theta, Theta). theta_([Sink|Sinks], Source, Costs, Alphas, Betas, Theta0, Theta) :- theta(Source, Sink, Costs, Alphas, Betas, Theta1), Theta2 is min(Theta0, Theta1), theta_(Sinks, Source, Costs, Alphas, Betas, Theta2, Theta). mark_unmark(Nodes, Hash, Mark, Unmark) :- mark_unmark(Nodes, Hash, Mark, [], Unmark, []). mark_unmark([], _, Mark, Mark, Unmark, Unmark). mark_unmark([Node|Nodes], Markable, Mark0, Mark, Unmark0, Unmark) :- ( memberchk(Node, Markable) -> Mark0 = [Node|Mark1], Unmark0 = Unmark1 ; Mark0 = Mark1, Unmark0 = [Node|Unmark1] ), mark_unmark(Nodes, Markable, Mark1, Mark, Unmark1, Unmark). all_markable(Flow, RevArcs, Markable) :- phrase(markable(s, [], _, Flow, RevArcs), Markable). all_markable([], Visited, Visited, _, _) --> []. all_markable([To|Tos], Visited0, Visited, Arcs, RevArcs) --> ( { memberchk(To, Visited0) } -> { Visited0 = Visited1 } ; markable(To, [To|Visited0], Visited1, Arcs, RevArcs) ), all_markable(Tos, Visited1, Visited, Arcs, RevArcs). markable(Current, Visited0, Visited, Arcs, RevArcs) --> { ( Current = p(_) -> ( get_assoc(Current, RevArcs, Fs) -> true ; Fs = [] ) ; ( get_assoc(Current, Arcs, Fs) -> true ; Fs = [] ) ) }, [Current], all_markable(Fs, [Current|Visited0], Visited, Arcs, RevArcs). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - solve(File) -- read input from File. Format (NS = number of sources, ND = number of demands): NS ND S1 S2 S3 ... D1 D2 D3 ... C11 C12 C13 ... C21 C22 C23 ... ... ... ... ... - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ input(Ss, Ds, Costs) --> integer(NS), integer(ND), n_integers(NS, Ss), n_integers(ND, Ds), n_kvectors(NS, ND, Costs). n_kvectors(0, _, []) --> !. n_kvectors(N, K, [V|Vs]) --> n_integers(K, V), { N1 is N - 1 }, n_kvectors(N1, K, Vs). n_integers(0, []) --> !. n_integers(N, [I|Is]) --> integer(I), { N1 is N - 1 }, n_integers(N1, Is). number([D|Ds]) --> digit(D), number(Ds). number([D]) --> digit(D). digit(D) --> [D], { between(0'0, 0'9, D) }. integer(N) --> number(Ds), !, ws, { name(N, Ds) }. ws --> [W], { W =< 0' }, !, ws. % closing quote for syntax highlighting: ' ws --> []. solve(File) :- time((phrase_from_file(input(Supplies, Demands, Costs), File), transportation(Supplies, Demands, Costs, Matrix), maplist(print_row, Matrix))), halt. print_row(R) :- maplist(print_row_, R), nl. print_row_(N) :- format("~w ", [N]). % ?- call_residue_vars(transportation([12,7,14], [3,15,9,6], [[20,50,10,60],[70,40,60,30],[40,80,70,40]], Ms), Vs). %@ Ms = [[0, 3, 9, 0], [0, 7, 0, 0], [3, 5, 0, 6]], %@ Vs = []. %?- call_residue_vars(simplex:solve('instance_80_80.txt'), Vs). %?- call_residue_vars(simplex:solve('instance_3_4.txt'), Vs). %?- call_residue_vars(simplex:solve('instance_100_100.txt'), Vs). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Assignment problem - for now, reduce to transportation problem assignment(Costs, Assignment) :- length(Costs, LC), length(Supply, LC), all_one(Supply), transportation(Supply, Supply, Costs, Assignment).