Plotting linear inequalities in Mathematica

后端 未结 3 449
谎友^
谎友^ 2021-01-06 10:17

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 Reg

3条回答
  •  说谎
    说谎 (楼主)
    2021-01-06 10:49

    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:

    alt text

    Downside: the undocumented function is not perfect. When the face is not a triangle, it will show a triangulation:

    alt text

    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:

    alt text

    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!

提交回复
热议问题