ENHANCED: library(simplex): Use a dual algorithm ("algorithm    alpha-beta" in Papadimitriou and Steiglitz) for transportation and    assignment problems, instead of a streamlined simplex algorithm.    The arising max-flow problem is solved with Edmonds-Karp, itself a    dual algorithm. The implementation is now much more scalable.
ENHANCED: library(simplex): Use a dual algorithm ("algorithm
   alpha-beta" in Papadimitriou and Steiglitz) for transportation and
   assignment problems, instead of a streamlined simplex algorithm.
   The arising max-flow problem is solved with Edmonds-Karp, itself a
   dual algorithm. The implementation is now much more scalable.

transportation/4 tested against CLP(FD) with:

   :- use_module(library(simplex)).
   :- use_module(library(clpfd)).

   length_(L, Ls) :- length(Ls, L).

   same_length([], []).
   same_length([_|Ls1], [_|Ls2]) :- same_length(Ls1, Ls2).

   run :-
           Upper = 3,
           length(Ls, L),
           portray_clause(L),
           append(Ss, Ds, Ls),
           % Ss = supplies, Ds = demands, Cs = cost
           Ss ins 1..Upper,
           Ds ins 1..Upper,
           same_length(Ss, Cs),
           sum(Ss, #=, S),
           sum(Ds, #=, S),
           maplist(same_length(Ds), Cs),
           append(Cs, CsVs),
           CsVs ins 1..Upper,
           maplist(label, [Ss,Ds,CsVs]),
           transportation(Ss, Ds, Cs, Minimum1),
           clpfd_transportation(Ss, Ds, Cs, Minimum2),
           maplist(total_cost(Cs), [Minimum1,Minimum2], [C1,C2]),
           (   C1 =:= C2 -> true
           ;   portray_clause(failed-(Ss,Ds,Cs,Minimum1-Minimum2,C1-C2))
           ),
           false.

   total_cost(Cs, Ms, Cost) :-
           cost_vector(Cs, Ms, CV),
           sum(CV, #=, Cost).

   clpfd_transportation(Ss, Ds, Cs, Minimum) :-
           same_length(Ss, Minimum),
           maplist(same_length(Ds), Minimum),
           maplist(list_sum, Minimum, Ss),
           transpose(Minimum, TMinimum),
           maplist(list_sum, TMinimum, Ds),
           cost_vector(Cs, Minimum, CostVec),
           sum(CostVec, #=, Cost),
           append(Minimum, Vs),
           Vs ins 0..sup,
           once(labeling([min(Cost)], Vs)).

   cost_vector([], _, []).
   cost_vector([C|Cs], [M|Ms], [Cost|Costs]) :-
           scalar_product(C, M, #=, Cost),
           cost_vector(Cs, Ms, Costs).

   list_sum(L, S) :- sum(L, #=, S).

   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      Transpose.
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

   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).

   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      Scalar product.
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

   scalar_product([], [], 0).
   scalar_product([W|Ws], [V|Vs], W*V+Rest) :-
           scalar_product(Ws, Vs, Rest).

   scalar_product(Cs, Vs, Rel, V) :-
           scalar_product(Cs, Vs, Term),
           call(Rel, Term, V).

mndrix/swipl-devel,koryonik/swipl-devel,edechter/swipl-devel,koryonik/swipl-devel,mndrix/swipl-devel,edechter/swipl-devel,mndrix/swipl-devel,jn7163/swipl-devel,edechter/swipl-devel,mndrix/swipl-devel,jn7163/swipl-devel,edechter/swipl-devel,mndrix/swipl-devel,jn7163/swipl-devel,koryonik/swipl-devel,jn7163/swipl-devel,edechter/swipl-devel,koryonik/swipl-devel,jn7163/swipl-devel,koryonik/swipl-devel