RE: Drawing specific contours in a 3D Surface Plot?

• To: mathgroup at smc.vnet.net
• Subject: [mg46021] RE: [mg46002] Drawing specific contours in a 3D Surface Plot?
• From: "David Park" <djmp at earthlink.net>
• Date: Tue, 3 Feb 2004 03:20:51 -0500 (EST)
• Sender: owner-wri-mathgroup at wolfram.com

```I was able to make this plot with the DrawGraphics package from my web site
below using the following code.

Needs["DrawGraphics`DrawingMaster`"]

f[t_] := Exp[-t/2];
g[u_, v_, w_] := BetaRegularized[u, v + 1, w - v];

First I extract the primitive Line graphics from three ImplicitPlots. I
raise the 2D contour Line to 3D and also offset the lines slightly so they
won't weave in and out of the surface.

c1 = ImplicitDraw[g[f[x], y, 200] == 0.5, {x, 0, 10}, {y, 0, 200},
PlotPoints -> 100] /. {x_?NumberQ,
y_?NumberQ} -> {x, y, 0.5} + {0.1, 1, 0};

c2 = ImplicitDraw[g[f[x], y, 200] == 0.5 + 0.3413, {x, 0, 10}, {y, 0, 200},
PlotPoints -> 100] /. {x_?NumberQ,
y_?NumberQ} -> {x, y, 0.5 + 0.3413} + {0.1, 1, 0};

c3 = ImplicitDraw[g[f[x], y, 200] == 0.5 - 0.3413, {x, 0, 10}, {y, 0, 200},
PlotPoints -> 100] /. {x_?NumberQ,
y_?NumberQ} -> {x, y, 0.5 - 0.3413} + {0.1, 1, 0};

Now I plot the surface and the three lines.
1) EdgeForm[] gets rid of the "mesh".
2) I colored the surface LightSteelBlue and used the DrawGraphics
NeutralLighting so it would not be colored by the regular lighting.

Draw3DItems[
{SurfaceColor[LightSteelBlue], EdgeForm[],
Draw3D[g[f[x], y, 200], {x, 0, 10}, {y, 0, 200}, PlotPoints -> 100],
c1, c2, c3},

NeutralLighting[0.3, 0.5, 0.1, 70°],
BoxRatios -> {1, 1, 1},
BoxStyle -> Gray,
Axes -> True,
AxesLabel -> {"x", "y", "g"},
ViewPoint -> {2.251, 2.048, 1.479},
Background -> Linen,
ImageSize -> 450];

David Park

From: Carsten Aulbert [mailto:carsten at welcomes-you.com]
To: mathgroup at smc.vnet.net

Hi,

is it possible to create a 3d plot of a smooth function f[x,y] (e.g. via
Plot3D[...]) and mark specific contour levels in this plot?

f[t_]:= Exp[-t/2];
g[u_,v_,w_]:=BetaRegularized[u, v + 1, w - v];

Plot3D[g[f[x], y,200], {x,0,10}, {y,0,200}]

In this plot (with Mesh->False and increased PlotPoints) I'd like to mark
the contours at 0.5, 0.5+/- 0.3413.

Is this possible?