# Graphically solving a linear programming problem

I try to realize the graphical linear programming method. Here is my code

Clear[GraphicalMethod]
GraphicalMethod[L_?VectorQ, A_?MatrixQ, b_?VectorQ, vars_?VectorQ] :=
Module[{obj = L.vars,
cond = Thread[A.vars <= b]~Join~Thread[vars >= 0], r, sol, x1, x2},
sol = Maximize[{L.vars, Thread[A.vars <= b]~Join~Thread[0 <= vars]},
vars];
x1 = Max[
First@vars /. Solve[#, First@vars] & /@
Thread[First /@ (A.vars) == b]];
x2 = Max[
Last@vars /. Solve[#, Last@vars] & /@
Thread[Last /@ (A.vars) == b]];
r = Sequence[Evaluate@{First@vars, 0, x1},
Evaluate@{Last@vars, 0, x2}];
Print[sol];
Manipulate[
Show[RegionPlot[And @@ cond, Evaluate@r,
BoundaryStyle -> {Blue, Thick}],
ContourPlot[Evaluate@Apply[Equal, cond, 1], Evaluate@r,
ContourStyle -> {{Blue, Thick}}],
ContourPlot[obj == k, Evaluate@r, ContourStyle -> {{Red, Thick}}]
], {{k, N@(First@sol)/2, "Objective Function"}, 0, First@sol,
Appearance -> "Open"}]]

GraphicalMethod[{12, 15}, {{4, 3}, {2, 5}}, {12, 10}, {x[1],x[2]}]


It can work for this example, but if we have conditions for 1 variable

GraphicalMethod[{12, 15}, {{4, 0}, {2, 5}}, {12, 10}, {x[1],x[2]}]


it

x1 = Max[First@vars /. Solve[#, First@vars] & /@
Thread[First /@ (A.vars) == b]];
x2 = Max[Last@vars /. Solve[#, Last@vars] & /@
Thread[Last /@ (A.vars) == b]];


gives False and function will not work. I understand why, but I haven't another ideas how to get the optimal interval r for x[1] and x[2]. Can you help me?

• Have you seen LinearProgramming which might ease the input of the problem?
– gwr
Commented Nov 10, 2015 at 14:14
• Welcome to Mathematica.SE! I suggest the following: 0) Browse the common pitfalls question 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! Commented Nov 10, 2015 at 15:00

## 2 Answers

I believe the following does more or less the same and is much easier to read:

Clear[GraphicalMethod];
GraphicalMethod[c_?VectorQ, m_?MatrixQ, b_?VectorQ] :=
Module[{k, eqs, l2, l1, jeq, x = {x1, x2}},
k = c.LinearProgramming[-c, m, Thread[{b, -1}]];
eqs = Reduce /@ Thread[m.x == b];
jeq = Join[eqs, {k == x.c}];
{l2, l1} = Max@Flatten[Solve /@ (jeq /. # -> 0)][[All, 2]] & /@ x;
Manipulate[
Show[
RegionPlot [And@@ Thread[m.x <= b], {x1, 0, l1}, {x2, 0, l2}],
ContourPlot[Evaluate@eqs,           {x1, 0, l1}, {x2, 0, l2}],
ContourPlot[k1 == x.c,              {x1, 0, l1}, {x2, 0, l2},ContourStyle -> Red]],
{{k1, k/2, "Objective Function"}, 0, k}]]

c = {12, 15};
m = {{4, 3}, {2, 5}};
b = {12, 8};

GraphicalMethod[c, m, b]


• Brilliant :) I'm very grateful to you Commented Nov 11, 2015 at 13:37
• One more question: maybe, it's better to write k = c.LinearProgramming[-c, m, Thread[{b, -1}]] ? Commented Nov 12, 2015 at 16:07
• @luck_liv Why do you think that that is better? Commented Nov 12, 2015 at 16:49
• LinearProgramming[c,m,b] finds a vector x that minimizes the quantity c.x subject to the constraints m.x>=b and x>=0. So, if it's maximize problem, we need to minimize the quantity -c.x subject to the constraints m.x<=b and x>=0. GraphicalMethod[{2, 4}, {{-2, 3}, {1, 1}, {3, -2}}, {12, 9, 12}] gives the wrong answer if k = c.LinearProgramming[c, m, b] Commented Nov 12, 2015 at 17:19
• @luck_liv Oh, I see. You're right. Going to edit the code. Thanks a lot for checking it Commented Nov 12, 2015 at 17:25

The following is a quick and dirty patch. You can do something more elegant taking it as a template:

Clear[GraphicalMethod]
GraphicalMethod[L_?VectorQ, A_?MatrixQ, b_?VectorQ, vars_?VectorQ] :=
Module[{obj = L.vars, cond = Thread[A.vars <= b]~Join~Thread[vars >= 0], r, sol, x1, x2},
sol = Maximize[{L.vars, Thread[A.vars <= b]~Join~Thread[0 <= vars]}, vars];
x1 = Max[First@vars /. Solve[#, First@vars] & /@ Thread[First /@ (A.vars) == b]];
x2 = Max[Last@vars /. Solve[#, Last@vars] & /@ Thread[Last /@ (A.vars) == b]];
x2 = First@ If[NumericQ[x2], {x2}, Evaluate[ Last[vars]] /. (Solve[
obj == sol[[1]] /. Evaluate[First[vars]] -> 0])];
x1 = First@ If[NumericQ[x1], {x1}, Evaluate[First[vars]] /. (Solve[
obj == sol[[1]] /. Evaluate[Last[vars]] -> 0])];
r = Sequence[Evaluate@{First@vars, 0, x1}, Evaluate@{Last@vars, 0, x2}];

Print[sol];
Manipulate[Show[
RegionPlot[And @@ cond, Evaluate@r, BoundaryStyle -> {Blue, Thick}],
ContourPlot[Evaluate@Apply[Equal, cond, 1], Evaluate@r, ContourStyle -> {{Blue, Thick}}],
ContourPlot[obj == k, Evaluate@r,
ContourStyle -> {{Red, Thick}}]], {{k, N@(First@sol)/2,
"Objective Function"}, 0, First@sol, Appearance -> "Open"}]]


And then

Row[{
GraphicalMethod[{12, 15}, {{4, 3}, {2, 5}}, {12, 10}, {x[1], x[2]}],
GraphicalMethod[{12, 15}, {{4, 0}, {2, 5}}, {12, 10}, {x[1], x[2]}],
GraphicalMethod[{12, 15}, {{4, 0}, {0, 5}}, {12, 10}, {x[1], x[2]}]}]