I have linear systems of inequalities in 3 variables and I'd like to plot these regions. Ideally, I'd like something that looks like objects in PolyhedronData. I tried RegionPlot3D, but the results are visually poor and too polygon-heavy to rotate in real time
Here's what I mean, the code below generates 10 sets of linear constraints and plots them
randomCons := Module[{},
hadamard = KroneckerProduct @@ Table[{{1, 1}, {1, -1}}, {3}];
invHad = Inverse[hadamard];
vs = Range[8];
m = mm /@ vs;
sectionAnchors = Subsets[vs, {1, 7}];
randomSection :=
Mean[hadamard[[#]] & /@ #] & /@
Prepend[RandomChoice[sectionAnchors, 3], vs]; {p0, p1, p2, p3} =
randomSection;
section =
Thread[m ->
p0 + {x, y, z}.Orthogonalize[{p1 - p0, p2 - p0, p3 - p0}]];
And @@ Thread[invHad.m >= 0 /. section]
];
Table[RegionPlot3D @@ {randomCons, {x, -3, 3}, {y, -3, 3}, {z, -3,
3}}, {10}]
Any suggestions?
Update: Incorporating suggestions below, here's the version I ended up using to plot feasible region of a system of linear inequalities
(* Plots feasible region of a linear program in 3 variables, \
specified as cons[[1]]>=0,cons[[2]]>=0,...
Each element of cons must \
be an expression of variables x,y,z only *)
plotFeasible3D[cons_] :=
Module[{maxVerts = 20, vcons, vertCons, polyCons},
(* find intersections of all triples of planes and get rid of \
intersections that aren't points *)
vcons = Thread[# == 0] & /@ Subsets[cons, {3}];
vcons = Select[vcons, Length[Reduce[#]] == 3 &];
(* Combine vertex constraints with inequality constraints and find \
up to maxVerts feasible points *)
vertCons = Or @@ (And @@@ vcons);
polyCons = And @@ Thread[cons >= 0];
verts = {x, y, z} /.
FindInstance[polyCons && vertCons, {x, y, z}, maxVerts];
ComputationalGeometry`Methods`ConvexHull3D[verts,
Graphics`Mesh`FlatFaces -> False]
]
Code for testing
randomCons := Module[{},
hadamard = KroneckerProduct @@ Table[{{1, 1}, {1, -1}}, {3}];
invHad = Inverse[hadamard];
vs = Range[8];
m = mm /@ vs;
sectionAnchors = Subsets[vs, {1, 7}];
randomSection :=
Mean[hadamard[[#]] & /@ #] & /@
Prepend[RandomChoice[sectionAnchors, 3], vs]; {p0, p1, p2, p3} =
randomSection;
section =
Thread[m ->
p0 + {x, y, z}.Orthogonalize[{p1 - p0, p2 - p0, p3 - p0}]];
And @@ Thread[invHad.m >= 0 /. section]
];
Table[plotFeasible3D[List @@ randomCons[[All, 1]]], {50}];
Here is a small program that seems to do what you want:
rstatic = randomCons; (* Call your function *)
randeq = rstatic /. x_ >= y_ -> x == y; (* make a set of plane equations
replacing the inequalities by == *)
eqset = Subsets[randeq, {3}]; (* Make all possible subsets of 3 planes *)
(* Now find the vertex candidates
Solving the sets of three equations *)
vertexcandidates =
Flatten[Table[Solve[eqset[[i]]], {i, Length[eqset]}], 1];
(* Now select those candidates
satisfying all the original equations *)
vertex = Union[Select[vertexcandidates, rstatic /. # &]];
(* Now use an UNDOCUMENTED Mathematica
function to plot the surface *)
gr1 = ComputationalGeometry`Methods`ConvexHull3D[{x, y, z} /. vertex];
(* Your plot follows *)
gr2 = RegionPlot3D[rstatic,
{x, -3, 3}, {y, -3, 3}, {z, -3, 3},
PerformanceGoal -> "Quality", PlotPoints -> 50]
Show[gr1,gr2] (*Show both Graphs superposed *)
The result is:
Downside: the undocumented function is not perfect. When the face is not a triangle, it will show a triangulation:
Edit
There is an option to get rid of the foul triangulation
ComputationalGeometry`Methods`ConvexHull3D[{x, y, z} /. vertex,
Graphics`Mesh`FlatFaces -> False]
does the magic. Sample:
Edit 2
As I mentioned in a comment, here are two sets of degenerate vertex generated by your randomCons
{{x -> Sqrt[3/5]},
{x -> -Sqrt[(5/3)] + Sqrt[2/3] y},
{x -> -Sqrt[(5/3)], y -> 0},
{y -> -Sqrt[(2/5)], x -> Sqrt[3/5]},
{y -> 4 Sqrt[2/5], x -> Sqrt[3/5]}
}
and
{{x -> -Sqrt[(5/3)] + (2 z)/Sqrt[11]},
{x -> Sqrt[3/5], z -> 0},
{x -> -Sqrt[(5/3)], z -> 0},
{x -> -(13/Sqrt[15]), z -> -4 Sqrt[11/15]},
{x -> -(1/Sqrt[15]), z -> 2 Sqrt[11/15]},
{x -> 17/(3 Sqrt[15]), z -> -((4 Sqrt[11/15])/3)}
}
Still trying to see how to cope gently with those ...
Edit 3
This code is not general enough for the full problem, but eliminates the cylinder degenerancy problem for your sample data generator. I used the fact that the pathogenic cases are always cylinders with their axis paralell to one of the coordinate axis, and then used RegionPlot3D to plot them. I'm not sure if this will be useful for your general case :(.
For[i = 1, i <= 160, i++,
rstatic = randomCons;
r[i] = rstatic;
s1 = Reduce[r[i], {x, y, z}] /. {x -> var1, y -> var2, z -> var3};
s2 = Union[StringCases[ToString[FullForm[s1]], "var" ~~ DigitCharacter]];
If [Dimensions@s2 == {3},
(randeq = rstatic /. x_ >= y_ -> x == y;
eqset = Subsets[randeq, {3}];
vertexcandidates = Flatten[Table[Solve[eqset[[i]]], {i, Length[eqset]}], 1];
vertex = Union[Select[vertexcandidates, rstatic /. # &]];
a[i] = ComputationalGeometry`Methods`ConvexHull3D[{x, y, z} /. vertex,
Graphics`Mesh`FlatFaces -> False, Axes -> False, PlotLabel -> i])
,
a[i] = RegionPlot3D[s1, {var1, -2, 2}, {var2, -2, 2}, {var3, -2, 2},
Axes -> False, PerformanceGoal -> "Quality", PlotPoints -> 50,
PlotLabel -> i, PlotStyle -> Directive[Yellow, Opacity[0.5]],
Mesh -> None]
];
]
GraphicsGrid[Table[{a[i], a[i + 1], a[i + 2]}, {i, 1, 160, 4}]]
Here you can find an image of the generated output, the degenerated cases (all cylinders) are in transparent yellow
HTH!
A triplet chosen from your set of inequalities will generally determine a point obtained by solving the corresponding triplet of equations. I believe that you want the convex hull of this set of points. You can generate this like so.
cons = randomCons; (* Your function *)
eqs = Apply[Equal, List @@@ Subsets[cons, {3}], {2}];
sols = Flatten[{x, y, z} /. Table[Solve[eq, {x, y, z}], {eq, eqs}], 1];
pts = Select[sols, And @@ (NumericQ /@ #) &];
ComputationalGeometry`Methods`ConvexHull3D[pts]
Of course, some triplets might actually be underdetermined and lead to lines or evan a whole plane. Thus the code will issue a complaint in those cases.
This appeared to work in the few random cases that I tried but, as Yaro points out, it doesn't work in all. The following picture will illustrate exactly why:
{p0, p1, p2,
p3} = {{1, 0, 0, 0, 0, 0, 0, 0}, {1, 1/2, -(1/2), 0, -(1/2), 0,
0, -(1/2)}, {1, 0, 1/2, 1/2, 0, 0, -(1/2), 1/2}, {1, -(1/2), 1/2,
0, -(1/2), 0, 0, -(1/2)}};
hadamard = KroneckerProduct @@ Table[{{1, 1}, {1, -1}}, {3}];
invHad = Inverse[hadamard];
vs = Range[8];
m = mm /@ vs;
section =
Thread[m ->
p0 + {x, y, z}.Orthogonalize[{p1 - p0, p2 - p0, p3 - p0}]];
cons = And @@ Thread[invHad.m >= 0 /. section];
eqs = Apply[Equal, List @@@ Subsets[cons, {3}], {2}];
sols = Flatten[{x, y, z} /. Table[Solve[eq, {x, y, z}], {eq, eqs}],
1]; // Quiet
pts = Select[sols, And @@ (NumericQ /@ #) &];
ptPic = Graphics3D[{PointSize[Large], Point[pts]}];
regionPic =
RegionPlot3D[cons, {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
PlotPoints -> 40];
Show[{regionPic, ptPic}]
Thus, there are points that are ultimately cut off by the plane defined by some other constraint. Here's one (I'm sure terribly inefficient) way to find the ones you want.
regionPts = regionPic[[1, 1]];
nf = Nearest[regionPts];
trimmedPts = Select[pts, Norm[# - nf[#][[1]]] < 0.2 &];
trimmedPtPic = Graphics3D[{PointSize[Large], Point[trimmedPts]}];
Show[{regionPic, trimmedPtPic}]
Thus, you could use the convex hull of trimmedPts. This ultimately depends on the result of RegionPlot and you might need to ramp of the value of PlotPoints to make it more reliable.
Googling about a bit reveals the concept of a feasibility region in linear programming. This seems to be exactly what you're after.
Mark
Seeing all the previous answers; what is wrong with using the build-in function RegionPlot3D, e.g.
RegionPlot3D[ 2*y+3*z <= 5 && x+y+2*z <= 4 && x+2*y+3*z <= 7 &&
x >= 0 && y >= 0 && z >= 0,
{x, 0, 4}, {y, 0, 5/2}, {z, 0, 5/3} ]
来源：https://stackoverflow.com/questions/3815496/plotting-linear-inequalities-in-mathematica