Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

RE: Polar diagram contour plots?

• To: mathgroup at smc.vnet.net
• Subject: [mg34576] RE: [mg34546] Polar diagram contour plots?
• From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
• Date: Wed, 29 May 2002 02:44:19 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

> -----Original Message-----
> From: heimann at ism.tu-berlin.de [mailto:heimann at ism.tu-berlin.de]
To: mathgroup at smc.vnet.net
> Sent: Monday, May 27, 2002 7:17 AM
> Subject: [mg34576] [mg34546] Polar diagram contour plots?
> 
> 
> Hi to you All,
> 
> I wonder if it is possible to plot polar diagrams as 3D and contour
> plots within Mathematica 4.0.
> 
> Imagine we have a list of discrete points given along radian cuts in
> the polar plane. In my case this is a plain Ascii data table generated
> by a different code. In Mathematica form this would look like, e.g.
> 
> foo = Table[Random[], {alpha, 0., 2.*Pi, dalpha}, {r, 0., rmax, dr}];
> 
> These data now can easily be transformed between polar and cartesian
> form, like
> 
> cartesian -> polar:
> -------------------
> r = (x^2 + y^2)^(1/2)
> alpha = Arctan[y/x]
> 
> polar -> cartesian:
> -------------------
> x = r Cos[alpha]
> y = r Sin[alpha]
> 
> What I desire is a 3d graph like ListPlot3D[] and 2d contour plots
> like ListContourPlot[] or ListDensityPlot[] would generate. But not on
> a cartesian grid but on a polar grid. The contour plots should show a
> legend, favourable the colour scale, in addition.
> 
> Unfortunately, I can't find any Mathematica function to do the job
> like expected. Does anyone know a workaround ? Any help is very much
> desired.
> 
> Many thanks
> Justus
> 

Justus,

just observe the following steps: 
First for a 3D plot

 
In[1]:= SeedRandom[0]

(* just to make things reproducible *)

In[2]:= dalpha = Pi/25; rmax = 1; dr = rmax/15;
In[3]:=
foo = Table[
      r*Sin[alpha]*Random[], {alpha, 0., 2.*Pi, dalpha}, {r, 0., rmax, dr}];

generate an ordinary SurfaceGraphics with ListPlot3D:

In[4]:= g0 = ListPlot3D[foo, MeshRange -> {{0, rmax}, {0, 2.*Pi}}]
Out[4]=
\[SkeletonIndicator]SurfaceGraphics\[SkeletonIndicator]

It was *important* to include the Mesh specification! 
Convert it to a Graphics3D object:

In[5]:= g1 = Graphics3D[g0]
Out[5]=
\[SkeletonIndicator]Graphics3D\[SkeletonIndicator]

Transform to point coordinates to cartesian:

In[6]:=
g2 = g1 /. 
    p : Polygon[
          pts_] :> (p /. {r_, alpha_, z_} :> {r Cos[alpha], r Sin[alpha],
z})
Out[6]=
\[SkeletonIndicator]Graphics3D\[SkeletonIndicator]

Show it:

In[7]:= Show[g2]
Out[7]=
\[SkeletonIndicator]Graphics3D\[SkeletonIndicator]

and you got it!



Contour plots are a little bit more difficult:

Start again making an ordinary contour plot, with the options you like:

In[8]:=
g0c = ListContourPlot[foo, MeshRange -> {{0, rmax}, {0, 2.*Pi}}, 
    Contours -> 2, ContourStyle -> Hue[0]]
Out[8]=
\[SkeletonIndicator]ContourGraphics\[SkeletonIndicator]

Convert it to a Graphics object

In[9]:= g1c = Graphics[g0c]
Out[9]=
\[SkeletonIndicator]Graphics\[SkeletonIndicator]

We are not yet ready to convert to cartesian coordinates: This is because we
get into trouble with long lines for the Polygons giving the contour shades.
We just have to brake this into small pieces:

In[10]:=
g1cfix = g1c /. 
    Polygon[pts_] :> 
      Polygon[Flatten[
          FoldList[
            Function[t, (1 - t)#1[[-1]] + t#2] /@ 
                With[{d = Ceiling[Max[Abs[#2 - #1[[-1]]]/{dalpha, dr}]]}, 
                  Range[d]/d] &, {First[pts]}, RotateLeft[pts]], 1]]
Out[10]=
\[SkeletonIndicator]Graphics\[SkeletonIndicator]

In[11]:=
Show[g1cfix]
Out[11]=
\[SkeletonIndicator]Graphics\[SkeletonIndicator]

Same appearance, we did nothing wrong. We go to cartesian:

In[12]:=
g2c = g1cfix /. 
    h : (Polygon | Line)[
          pts_] :> (h /. {r_, alpha_} :> {r Cos[alpha], r Sin[alpha]})
Out[12]=
\[SkeletonIndicator]Graphics\[SkeletonIndicator]

In[13]:= Show[g2c]
Out[13]=
\[SkeletonIndicator]Graphics\[SkeletonIndicator]


A note to add: I was able to quickly get at this solution, because some
years ago I saw a post of Allan Hayes to this theme (scan the archive!).
Also David Park contributed to prior threads. I'm almost certain that he
incorporated this into his own graphics package.

Finally, the correct transformation from cartesian to polar is:

 cartesian -> polar:
 -------------------
 r = (x^2 + y^2)^(1/2)
 alpha = ArcTan[x,y]

--
Hartmut