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
>