Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2001
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2001

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

Search the Archive

RE: Surface graphics (Plot3D) colouring question

  • To: mathgroup at smc.vnet.net
  • Subject: [mg31854] RE: [mg31822] Surface graphics (Plot3D) colouring question
  • From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.de>
  • Date: Fri, 7 Dec 2001 05:56:49 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

> -----Original Message-----
> From:	DIAMOND Mark R. [SMTP:dot at dot.dot]
To: mathgroup at smc.vnet.net
> Sent:	Wednesday, December 05, 2001 12:52 PM
> To:	mathgroup at smc.vnet.net
> Subject:	[mg31822] Surface graphics (Plot3D) colouring question
> 
> Background: I have reason to calculate the volume over a (non-centred)
> circular area of a bivariate normal distribution (BND). By non-centred, I
> simply mean that the centre of the disc does not correspond with the means
> of the two normal distributions.
> 
> My solution was to change the (BND) to polar coordinates and then
> integrate
> over r and theta of the circular area. Seems OK although I'd be interested
> in any better solution.
> 
> Current problem (question). I would like to illustrate what is being done
> in
> the integration, and to this end would like to construct a surface graphic
> (probably with Plot3D or ListPlot3D) of the BND, but then I would like to
> color a part of the suface (the part being defined by the underlying disc)
> in a distinctive colour (I should probably say "distinctive colours" since
> keeping some part of the Lighting as well as grid would be nice). Has
> anyone
> done something like this before? I searched the archive but found no
> similar
> question.
> 
> Cheers
> 
> --
> Mark R. Diamond
> Send email to  psy dot uwa dot edu dot au and address to markd
> http://www.psy.uwa.edu.au/user/markd
> 
[Hartmut Wolf] 
A simple way to visualize a circular region on the 2-dimensional
distribution would be:

<<Statistics`NormalDistribution`

dis=PDF[NormalDistribution[0,1],x] PDF[NormalDistribution[0,1],y] 

Now you can use the color specification to mark the region colored:

Plot3D[{dis, If[(x-0.8)^2+(y+0.5)^2<1,Hue[0],Hue[0.6]]},{x,-2,2},{y,-2,2}]

This is rather crude. You may increase PlotPoints -> 50 and set Mesh ->
False, but obviously you will loose the 3D-illusion to the eye. Specifying
SurfaceColor didn't work in my Version 4.1.0 (although it should according
to Help), so use ParametricPlot3D

ParametricPlot3D[{x,y,
    dis, {EdgeForm[],
      If[(x-0.8)^2+(y+0.5)^2<1,SurfaceColor[Hue[0,0.2,1]],
        SurfaceColor[Hue[0.6,0.2,1]]]}},{x,-2,2},{y,-2,2},PlotPoints -> 50,
  BoxRatios -> {1,1,0.4}]

Less than perfect, but keeping the mesh lines makes things not any better.
However you may keep _some_ of the mesh lines, using a package Allan Hayes 
published some time after June 2000 (scan the archive). With that

<<Smooth3D`

?Smooth3D
Smooth3D[plotfn[.,{x..},{y..}], MeshLines -> {xln ,yln}, MeshStyle -> {xstl,
\
ystl}, Smoothing -> {sx,sy}] gives xln mesh lines with style xstl at equally
\
spaced x values, and with the x-spacing between the plot points not more
than \
1/sx times that for plotfn[.,{x..},{y..}](similarly with x replaced by y). \
Where plotfn can be Plot3D, ParametricPlot3D, CylindricalPlot3D or \
SphericalPlot3D.  The defaults for the options are
     Smoothing -> 1 {equivalent to {1,1}}
     MeshLines -> Automatic 
 (giving same numbers of mesh lines as the original)
     MeshStyle -> Automatic


Smooth3D[ParametricPlot3D[{x,y,
      dis, If[(x-0.8)^2+(y+0.5)^2<1,SurfaceColor[Hue[0,0.2,1]],
          SurfaceColor[Hue[0.6,0.2,1]]]},{x,-2,2},{y,-2,2},
    BoxRatios\[Rule]{1,1,0.4}],Smoothing\[Rule]5]

Quite pleasing to the eye, I think. Look from above:

Show[%,ViewPoint -> {0,-0.1,10}]

You may not like the borderline of the circle blurred. 
To have that sharp takes more work (I haven't the time to do right now):

(1) make a Graphics3D object of the distribution.

(2) take the Polygons out, and have the circle cut through according 
    to (x,y)-coordinates.

(3) Seperate and group the Polygons cut "inside" and "outside"

(4) add different SurfaceColor to both groups.

(5) put them back into the Graphics3D object and Show


Perhaps you'll be happy with a simple 2D-visualization:

make a CountourPlot of the Distribution

g1=ContourPlot[dis,{x,-2,2},{y,-2,2},PlotPoints -> 40,
    ColorFunction -> (Hue[0.6,#,1]&),ColorFunctionScaling -> True]

draw the circle, e.g.

<<Graphics`ImplicitPlot`

g2=ImplicitPlot[(x-0.8)^2+(y+0.5)^2==1, {x,-2,2},
    PlotRange -> {{-2,2},{-2,2}},PlotStyle -> Hue[0]]

Show[g1,g2]

simple and perhaps good enough!


---------------------

Well, after some reluctance I dared to make it:

(1) get the SurfaceGraphics: 

g=Plot3D[dis ,{x,-2,2},{y,-2,2}]

(2) convert it to Graphics3D:

g3D=Graphics3D[g]

(3) define some helper functions:

tagwhere[p_]:=If[With[{d=Take[p,2]-{0.8,-0.5}},d.d<1],{p,inside},{p,outside}
]

...tags all pts whether inside or outside the circle.

sol[{p1_,_},{p2_,_}]:=Module[{p,d,e},
    p=p1 (1-d) + p2 d;e= Take[p,2]-{0.8,-0.5};
    First[
      Cases[Solve[e.e\[Equal]1,d],s_/;Positive[d/.s]\[RuleDelayed](p/.s)]]
    ]

...finds intermediate points on the circle.

sep[pp1_,pp2_]:=If[pp1[[2]]===pp2[[2]],{pp1},
    ppx=sol[pp1,pp2];{pp1,{ppx,pp1[[2]]},{ppx,pp2[[2]]}}]

...if both points are at the same side, take one
...if at different sides, take one and add the point on the circle to one
side, 
   and also again to the other side.


With that manipulate the graphics:

gnew2=g3D/.Polygon[pts:{p1_,p2_,p3_,p4_}]\[RuleDelayed]
      With[{tagpts=tagwhere/@pts},
        With[{t=sep@@@
                Transpose[{tagpts,RotateLeft[tagpts]}]},{With[{newpts=
                  Cases[t,{p_,label_}/;label==outside\[RuleDelayed] p,2]},
              If[Length[newpts]>2,{FaceForm[SurfaceColor[Hue[0.6,0.3,1]]],
                  Polygon[newpts]},{}]],
            With[{newpts=
                  Cases[t,{p_,label_}/;label\[Equal]inside\[RuleDelayed] p,
                    2]},If[Length[newpts]>
                  2,{FaceForm[SurfaceColor[Hue[0,0.3,1]]],
                  Polygon[newpts]},{}]]}]]
Show[gnew2]


If you don't want the Lighting, use strong colors

gnew=g3D/.Polygon[pts:{p1_,p2_,p3_,p4_}]\[RuleDelayed]
      With[{tagpts=tagwhere/@pts},
        With[{t=sep@@@
                Transpose[{tagpts,RotateLeft[tagpts]}]},{With[{newpts=
                  Cases[t,{p_,label_}/;label==outside\[RuleDelayed] p,2]},
              If[Length[newpts]>2,{FaceForm[Hue[0.6]],Polygon[newpts]},{}]],
            With[{newpts=
                  Cases[t,{p_,label_}/;label\[Equal]inside\[RuleDelayed] p,
                    2]},If[Length[newpts]>2,{FaceForm[Hue[0]],
                  Polygon[newpts]},{}]]}]]

Show[gnew,Lighting\[Rule]False]

3D-illusion is now only from the Mesh.



Hartmut Wolf



  • Prev by Date: Re: scope all wrong? in Mathematica 4.1
  • Next by Date: Re: scope all wrong? in Mathematica 4.1
  • Previous by thread: Surface graphics (Plot3D) colouring question
  • Next by thread: WTB: Control Systems Professional for Mathematica 2.2 for the Macintosh