Re: Raising Contour Plot Graphics to 3D - II
- To: mathgroup at smc.vnet.net
- Subject: [mg37327] Re: Raising Contour Plot Graphics to 3D - II
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Wed, 23 Oct 2002 02:57:20 -0400 (EDT)
- References: <ap085r$c77$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
David,
Thanks for pointing our your second post - I should have looked at it before
posting my earlier effort
However I may be able to add something:
Re non-convex polygons - we can use the package
ExtendGraphics`NonConvexTriangulate` in TomWickham Jones collection
ExtendGraphics - available from MathSource.
cgr = ContourPlot[x^2 + y^2, {x, -3, 3}, {y, -3, 3},
ColorFunction -> (Hue[(2/3)*#1] & ), ContourStyle -> {GrayLevel[1]}];
Convert to graphics objects
gr = First[Graphics[cgr]];
Show[Graphics[{gr}]];
Triangulate to deal with non-convex polygons:
<< "ExtendGraphics`NonConvexTriangulate`"
tri = gr /. Polygon[pts_] :> Sequence @@ (Polygon[pts[[#1]]] & ) /@
NonConvexTriangulate[pts];
Show[Graphics[tri]]
\[SkeletonIndicator]Graphics\[SkeletonIndicator]
Make affine transfomation and choose the view point to be used (if we are
using the default view point then vp = {1.3,-2.4,2.}). Use EdgeForm[ ] so
that the edges of the triangle in tri are not displayed.
The order that the polygons and lines appear in gr is the order in which
they will be rendered, the later ones on top of the earlier ones.
Simulate this in three dimensions by lifting the polygons and lines slightly
towards the view point the later ones more than the later ones
vp = {1, -2, 2};
gr3D = {EdgeForm[], Table[tri[[i]] /. {(x_)?NumericQ, (y_)?NumericQ} ->
{2*x + y, -x + 2*y, -1.5*x + y} + i*(vp/10000),
{i, 1, Length[tri]}]};
Show[Graphics3D[{gr3D}], Lighting -> False, ViewPoint -> vp];
--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565
"David Park" <djmp at earthlink.net> wrote in message
news:ap085r$c77$1 at smc.vnet.net...
> 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/
>
>
>
>