Skip to main content

plotting - 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?




Answer



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]

Mathematica graphics


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...

plotting - How to draw some 2D curves in a 3D plot?

I want to plot several 2D curves ( Sin[x] at y=0 , Cos[x] at y=1 ) in a 3D plot, what function should i use? f[x_, y_] := Piecewise[{{0, y 0}, {Sin[x], y == 0}}] g[x_, y_] := Piecewise[{{0, y 1}, {Cos[x], y == 1}}] Plot3D[{f[x, y], g[x, y]}, {x, 0, 10}, {y, 0, 10}] doesn't work. Any ideas? Answer ParametricPlot3D[{{Sin[u], 0, u}, {Cos[u], 1, u}}, {u, 0, 20}, BoxRatios -> 1, PlotRange -> {{-2, 2}, {-.5, 2}, {0, 20}}] === update - general thoughts === I've seen the comments to this question and a few other approaches to the waterfall (or wire) plot are given in this question: Plotting several functions . Also I cannot not mention one of my favorite Mathematica blogs - Archery with this post on the story of discovery of 1st pulsar and an its infamous graphics - code is given in the post: