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/