Raising Contour Plot Graphics to 3D - II
- To: mathgroup at smc.vnet.net
- Subject: [mg37281] Raising Contour Plot Graphics to 3D - II
- From: "David Park" <djmp at earthlink.net>
- Date: Mon, 21 Oct 2002 02:30:47 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
MathGroup,
This provides additional information and examples for my earlier posting.
I am trying to use ContourPlot to generate colored planar Polygons
representing contour regions, and then map them into 3D planar Polygons.
There are two problems.
1) The output from converting ContourGraphics to Graphics is not separate
polygons for each contour region, but a series of overlapping polygons.
Mathematica takes advantage of the fact that in 2D you can lay one Polygon
on top of another. But when we convert the Polygons to 3D objects,
Mathematica has difficulties. Laying one polygon over another in 3D
generally confuses Mathematica's rendering, and perhaps is a difficult 3D
problem in general. There is a solution. We can just separate the Polygons
into layers with separations just large enough to unconfuse the rendering.
As long as we only look at the "top" side, this works. I illustrate a case
below.
2) Mathematica does not correctly render planar polygons that have a concave
edge. This despite the fact that the Polygon Help says: "In three
dimensions, planar polygons that do not intersect themselves will be drawn
exactly as you specify them." But how does Mathematica determine that a
Polygon is planar, once approximate numbers have been introduced? Somehow we
need a method to specify that a 3D Polygon is to be taken as planar,
regardless of round off errors.
Now for examples.
Needs["Graphics`Animation`"]
cplot = ContourPlot[x y, {x, -3, 3}, {y, -3, 3}, ColorFunction -> Hue];
We extract the colors and Polygons and throw away the Lines. (In 2D
Mathematica does not draw the edges of Polygons; in 3D it does.)
cgraphics2d =
Cases[First[Graphics[cplot]], a : {Hue[_], Polygon[_], ___} :> Take[a,
2],
Infinity];
Now we convert the Polygons to 3D objects, introduce an exaggerated spacing
between layers and plot it. It illustrates how Mathematica uses an overlay
technique on ContourPlots.
cgraphics3da =
Table[Part[cgraphics2d,
i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.1 i}, {i, 1,
Length[cgraphics2d]}];
Show[Graphics3D[
{cgraphics3da},
Lighting -> False,
ImageSize -> 450]];
Here is the same case with close spacing and an affine transformation to 3D
space.
cgraphics3da =
Table[Part[cgraphics2d,
i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.000001 i}, {i, 1,
Length[cgraphics2d]}];
cgraphics3db =
cgraphics3da /. {x_?NumericQ, y_?NumericQ,
z_?NumericQ} -> {2x + y, -x + 2y, -1.5x + y + z};
plot1 =
Show[Graphics3D[
{cgraphics3db},
Lighting -> False,
ImageSize -> 450]];
SpinShow[plot1, SpinOrigin -> {0, 0, 0}, SpinDistance -> 5]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]
FrontEndTokenExecute["SelectionAnimate"]
That works well, but if our contour regions have concave edges, we run into
the second problem.
cplot = ContourPlot[x^2 + y^2, {x, -3, 3}, {y, -3, 3}, ColorFunction ->
Hue];
cgraphics2d =
Cases[First[Graphics[cplot]], a : {Hue[_], Polygon[_], ___} :> Take[a,
2],
Infinity];
cgraphics3da =
Table[Part[cgraphics2d,
i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.1 i}, {i, 1,
Length[cgraphics2d]}];
Show[Graphics3D[
{cgraphics3da},
Lighting -> False,
ImageSize -> 450]];
The 3D Polygons are rendered to extend outside the actual region, presumably
because Mathematica does not recognize them as planar. So, if we do a
closely spaced 3D plot as with the other function, we do not obtain properly
colored regions.
cgraphics3da =
Table[Part[cgraphics2d,
i] /. {x_?NumericQ, y_?NumericQ} -> {x, y, 0.00001 i}, {i, 1,
Length[cgraphics2d]}];
cgraphics3db =
cgraphics3da /. {x_?NumericQ, y_?NumericQ,
z_?NumericQ} -> {2x + y, -x + 2y, -1.5x + y + z};
plot1 =
Show[Graphics3D[
{cgraphics3db},
Lighting -> False,
ImageSize -> 450]];
SpinShow[plot1, SpinOrigin -> {0, 0, 0}, SpinDistance -> 5]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]
FrontEndTokenExecute["SelectionAnimate"]
Does anyone have any ideas for solving this problem?
David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/