Re: Constraint visualization

*To*: mathgroup at smc.vnet.net*Subject*: [mg85812] Re: Constraint visualization*From*: "David Park" <djmpark at comcast.net>*Date*: Sat, 23 Feb 2008 04:24:30 -0500 (EST)*References*: <fpkvmq$hpm$1@smc.vnet.net>

All the work is to convert a region specification into a specification for the various faces of the region. I did this plot using the Presentations package from my web site, but this could be done with only slightly more difficulty with regular Mathematica graphics. The following are the specified regions where I have use a >= on the maximum y value. regions = (Fm <= 120/(8 - y) && 8 - y >= 0 && ((Fm <= 69.6`/(2.4`+ 2 x) && x >= 0) || (Fm <= 69.6`/(2.4`- 2 x) && x <= 0)) && ((Fm <= 69.6`/(2.4`+ 2 x) && x >= 0) || (Fm <= 69.6`/(2.4`- 2 x) && x <= 0)) && Fm <= 112/y && y >= 0) || (Fm <= 120/(8 - y) && y <= 0 && ((Fm <= 69.6`/(2.4`+ 2 x) && x >= 0) || (Fm <= 69.6`/(2.4`- 2 x) && x <= 0))) || (Fm <= 112/y && y >= 8 && ((Fm <= 69.6`/(2.4`+ 2 x) && x >= 0) || (Fm <= 69.6`/(2.4`- 2 x) && x <= 0))); We add the desired x and y domains as extra conditions and then do a LogicalExpand to obtain 15 faces. There are 5 more faces that Mathematica misses that we will have to fill in. Reduce[regions \[And] -2.6 <= x <= 2.6 \[And] -3 <= y <= 9.6 \[And] Fm >= 0, Fm] // Quiet; faces = % // LogicalExpand Length[%] The first few 'faces' are points or side faces. We write a cooresponding graphics object for each face. Part[faces, 1] face[1] = {Black, AbsolutePointSize[5], Point[{0, 3.86207, 29}]}; Part[faces, 2] face[2] = ParametricDraw3D[{x, -3, Fm}, {x, -1.99, 1.99}, {Fm, 0, 10.9091}, BoundaryStyle -> Black, Mesh -> None]; Part[faces, 3] face[3] = ParametricDraw3D[{x, -3, Fm}, {x, 1.99, 2.6}, {Fm, 0, 174.`/( 6.`+ 5.` x)}, BoundaryStyle -> Black, Mesh -> None]; Part[faces, 4] face[4] = ParametricDraw3D[{x, -3, Fm}, {x, -2.6, -1.99}, {Fm, 0, -(174.`/(-6.` + 5.` x))}, BoundaryStyle -> Black, Mesh -> None]; Part[faces, 5] face[5] = ParametricDraw3D[{x, 3.86207, Fm}, {x, 0, 2.6}, {Fm, 0, 174.`/( 6.`+ 5.` x)}, BoundaryStyle -> Black, Mesh -> None]; Part[faces, 6] face[6] = ParametricDraw3D[{x, 3.86207, Fm}, {x, -2.6, 0}, {Fm, 0, -(174.`/(-6.` + 5.` x))}, BoundaryStyle -> Black, Mesh -> None]; The remaining faces are all top surfaces. We write a routine to extract t= he parametric parameters for the logic expression and draw the corresponding surface. MakeParametricDraw[andexpression_] := Module[{xmin, xmax, ymin, ymax, Fmfunction}, xmin = First@ Cases[andexpression, ((min_ < x) | (min_ <= x)) -> min, \[Infinity]]; xmax = First@ Cases[andexpression, ((x < max_) | (x <= max_)) -> max, \[Infinity]]; ymin = First@ Cases[andexpression, ((min_ < y) | (min_ <= y)) -> min, \[Infinity]]; ymax = First@ Cases[andexpression, ((y < max_) | (y <= max_)) -> max, \[Infinity]]; Fmfunction = First@Cases[ andexpression, ((Fm <= max_) | (Fm < max)) -> max, \[Infinity]]; ParametricDraw3D @@ {{x, y, Fmfunction}, {y, ymin, ymax}, {x, xmin, xmax}, BoundaryStyle -> Black, Mesh -> None} ] Then we generate all the remaining Mathematica generated faces. Do[face[i] = MakeParametricDraw[Part[faces, i]], {i, 7, 15}]; We have to obtain the faces at y = 9.6, which Mathematica omitted. It is necessary to do another reduce for this. Reduce[regions \[And] y == 9.6 \[And] -2.6 <= x <= 2.6, Fm] // Quiet face[16] = ParametricDraw3D[{x, 9.6, Fm}, {x, -1.78286, 1.78286}, {Fm, 0, 11.6667}, BoundaryStyle -> Black, Mesh -> None]; face[17] = ParametricDraw3D[{x, 9.6, Fm}, {x, -2.6, -1.78286}, {Fm, 0, -(174.`/(-6.` + 5.` x))}, BoundaryStyle -> Black, Mesh -> None]; face[18] = ParametricDraw3D[{x, 9.6, Fm}, {x, 1.78286, 2.6}, {Fm, 0, 174.`/( 6.`+ 5.` x)}, BoundaryStyle -> Black, Mesh -> None]; And finally we put in the two remaining sides. 174.`/(6.`+ 5.` x) /. x -> 2.6 9.15789 face[19] = ParametricDraw3D[{-2.6, y, Fm}, {y, -3, 9.6}, {Fm, 0, 9.15789}, BoundaryStyle -> Black, Mesh -> None]; face[20] = ParametricDraw3D[{2.6, y, Fm}, {y, -3, 9.6}, {Fm, 0, 9.15789}, BoundaryStyle -> Black, Mesh -> None]; Finally we draw all the faces. All the faces are smooth surfaces, smoothly joined, and the plot is much cleaner that the RegionPlot3D. I made all the faces the same color, but transparent. Different colors could be specified for each face but I don't know what the best scheme would be. Draw3DItems[ {Opacity[.8], Orange, face[1], face[2], face[3], face[4], face[5], face[6], face[7], face[8], face[9], face[10], face[11], face[12], face[13], face[14], face[15], face[16], face[17], face[18], face[19], face[20] }, NeutralLighting[.0, .5, .2, 50 B0], Axes -> True, AxesLabel -> {x, y, Fm}, NiceRotation, PlotRange -> {{-2.7, 2.7}, {-3.1, 9.7}, {0, All}}, PlotRangePadding -> {.1, .2, .5}, ViewPoint -> {2.45377, -1.7663, 1.5196}, BoxRatios -> {1, 1, 1}, ImageSize -> 500] -- David Park djmpark at comcast.net http://home.comcast.net/~djmpark/ "NeilJ" <neiljac at gmail.com> wrote in message news:fpkvmq$hpm$1 at smc.vnet.net... > Hallo, > > I am brand new to Mathematica. I have acquired the program to assist > me in constraints/solution space visualization but the results I got > from my fiddling the past two weeks have been fairly disappointing. (I > must admit that I've elarnt a lot of wonderful new things but I am > still unable to carry out my initial objective.) > > If I can find out how to color all the faces/edges of the following > regionplot it will help me a lot. > > RegionPlot3D[ > Or[And[And[And[Fm <= 120/(8 - y), 8 - y >= 0], > Or[And[Fm <= 69.6/(2.4 + 2 x), x >= 0], > And[Fm <= 69.6/(2.4 - 2 x), x <= 0]]], > And[Or[And[Fm <= 69.6/(2.4 + 2 x), x >= 0], > And[Fm <= 69.6/(2.4 - 2 x), x <= 0]], And[Fm <= 112/y, y > 0]= ]], > And[And[Fm <= 120/(8 - y), y < 0], > Or[And[Fm <= 69.6/(2.4 + 2 x), x >= 0], > And[Fm <= 69.6/(2.4 - 2 x), x <= 0]]], > And[And[Fm <= 112/y, y > 8], > Or[And[Fm <= 69.6/(2.4 + 2 x), x >= 0], > And[Fm <= 69.6/(2.4 - 2 x), x <= 0]]]], {x, -2.6, 2.6}, {y, -3, > 9.6}, {Fm, 0, 30}] > > Neil Jacobs >