Question

我有3个变量的不等式线性系统，我想绘制这些区域。理想情况下，我想在PolyhedronData中看起来像对象。我试过了RegionPlot3D，但结果在视觉上很差，而且多边形太重，无法实时旋转

这就是我的意思，下面的代码生成10组线性约束并绘制它们

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}]

有什么建议吗？

更新：结合以下建议，这是我最终用于绘制线性不等式系统的可行区域的版本

(* 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]
  ]

测试代码

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}];

Answer 1

从您的不等式集合中选择的三元组通常会确定通过求解相应的三元组方程得到的点。我相信你想要这套点的凸包。你可以这样生成它。

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]

当然，一些三胞胎实际上可能是不确定的，并导致线或逃避整个飞机。因此，代码将在这些情况下发出投诉。

这似乎适用于我尝试过的少数随机案例，但正如Yaro所指出的那样，它根本不起作用。以下图片将说明原因：

{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}]

因此，有些点最终被一些其他约束定义的平面切断。这是找到你想要的那种方式（我确定非常低效）。

regionPts = regionPic[[1, 1]];
nf = Nearest[regionPts];
trimmedPts = Select[pts, Norm[# - nf[#][[1]]] < 0.2 &];
trimmedPtPic = Graphics3D[{PointSize[Large], Point[trimmedPts]}];
Show[{regionPic, trimmedPtPic}]

因此，您可以使用trimmedPts的凸包。这最终取决于RegionPlot的结果，您可能需要斜接PlotPoints的值以使其更可靠。

谷歌搜索揭示了线性规划中可行性区域的概念。这似乎正是你所追求的。

标记

Answer 2

这是一个似乎可以做你想做的小程序：

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

结果是：

alt text

下行：未记录的功能并不完美。当面不是三角形时，它将显示三角剖分：

alt text

修改

可以选择摆脱犯规三角测量

 ComputationalGeometry`Methods`ConvexHull3D[{x, y, z} /. vertex,
                                Graphics`Mesh`FlatFaces -> False]

真有效。样品：

alt text

编辑2

正如我在评论中提到的，这里有两组由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]}
 }

和

{{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)}
}

仍然试着看看如何轻轻应对......

编辑3

此代码对于完整问题不够通用，但消除了样本数据生成器的柱面退化问题。我使用的事实是，致病病例总是圆柱体，它们的轴并列到坐标轴之一，然后使用RegionPlot3D绘制它们。我不确定这对你的一般情况是否有用：（。

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你可以找到生成输出的图像，退化的情况（所有圆柱体）都是透明的黄色

HTH！

Answer 3

查看以前的所有答案;使用内置函数有什么问题 RegionPlot3D，例如

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} ]

在Mathematica中绘制线性不等式

3 个答案: