Re: Dynamic tangential plane - how?
- To: mathgroup at smc.vnet.net
- Subject: [mg92918] Re: Dynamic tangential plane - how?
- From: "David Park" <djmpark at comcast.net>
- Date: Sun, 19 Oct 2008 05:41:06 -0400 (EDT)
- References: <gdcdh5$fkf$1@smc.vnet.net>
For those who have the Presentations package, here are two methods for
drawing dynamic tangent planes controlled by a Locator. In both of the
methods I make two plots in a row. The left hand plot is a contour plot of
the function with a Locator on top of it. For the Locator I use a smaller
red CirclePoint. The right hand plot is the parametrically drawn surface
with the addition of the tangent plane and the point of tangency. The
difference between the two methods is how the tangent plane is drawn.
Needs["Presentations`Master`"]
In the first method I used Mike's domain and because of the wide range of z
values this gives an ackward box shape unless we specify BoxRatios. But
specifying BoxRatios distorts the true shape of the surface. This isn't
ideal, but nevertheless we can still draw a tangent plane.
f[x_, y_] := (1 - x^2) (2 x - y^3)
grad[x_, y_] := {2 (1 - x^2) - 2 x (2 x - y^3), -3 (1 - x^2) y^2}
Module[
{(* Primary dynamic variable *)
pt = {0, 0},
(* Dependent dynamic variables *)
x0, y0,
(* Other objects *)
calcAll, contourplot},
(* Background for LocatorPane *)
contourplot =
With[
{contourvalues = {-30, -20, -10, -5, -2, -1, -.5, 0, .5, 1, 2, 5,
10, 20}},
Draw2D[
{ContourDraw[f[x, y], {x, -2, 2}, {y, -2, 2},
Contours -> contourvalues,
ColorFunctionScaling -> False,
ColorFunction ->
ContourColors[contourvalues, ColorData["CoffeeTones"]],
PlotRange -> {-40, 40}]},
Frame -> True,
ImageSize -> 350]
];
(* Calculate the coordinates *)
calcAll[p_] := {x0, y0} = p;
(* Initialize the coordinates *)
calcAll[pt];
(* Display *)
Row[
{(* Locator on top of contour plot *)
LocatorPane[Dynamic[pt, (pt = #; calcAll[pt]) &], contourplot,
Appearance ->
Graphics[CirclePoint[{0, 0}, 3, Black, Red], ImageSize -> 20]],
Spacer[10],
(* Surface plot with tangent plane *)
Draw3DItems[
{Opacity[.5, ColorData["CoffeeTones"][.5]],
ParametricDraw3D[{x, y, f[x, y]}, {x, -2, 2}, {y, -2, 2},
Mesh -> None],
Dynamic@
{Green,
ParametricDraw3D[{x, y,
f[x0, y0] + grad[x0, y0].{x - x0, y - y0}}, {x, x0 - 1,
x0 + 1}, {y, y0 - 1, y0 + 1},
Mesh -> 5, MeshStyle -> Darker@Green],
Red, AbsolutePointSize[8], Point[{x0, y0, f[x0, y0]}]}},
NeutralLighting[0, .5, .1],
NiceRotation,
PlotRange -> {{-3, 3}, {-3, 3}, {-40, 40}},
BoxRatios -> {1, 1, 1}, Boxed -> False,
ImageSize -> 350]
}]
]
The fastest way to move the tangent point is to just click the point on the
left hand plot. It helps to zoom the 3D plot once the display is produced.
One of the problems with this method is that the visual size of the tangent
plane varies as we move it about the surface.
The second method can be used if the surface is plotted with BoxRatio ->
Automatic. (We can do this if we use a PlotRange of 1 instead of 2 with this
function.) Then angles and lengths are preserved. We derive an expression
for a normal vector to the surface at each point. The tangent plane is then
produced by first drawing a prototype fixed size 'tangent' plane at the
origin in the xy-plane. Then we simply rotate the vector {0,0,1} to the
normal direction and translate the result to the tangent point. The
advantage of this method is that the visualized tangent plane segment is
always the same size.
f[x_, y_] := (1 - x^2) (2 x - y^3)
gx[x_, y_] = D[{x, y, f[x, y]}, x];
gy[x_, y_] = D[{x, y, f[x, y]}, y];
normal[x_, y_] = gx[x, y]\[Cross]gy[x, y] // Simplify
Module[
{(* Primary dynamic variable *)
pt = {0, 0},
(* Dependent dynamic variables *)
x0, y0,
(* Other objects *)
calcAll, contourplot, tangentplane},
(* Back plot for the LocatorPane *)
contourplot = With[
{contourvalues = Range[-2, 2, .25]},
Draw2D[
{ContourDraw[f[x, y], {x, -1, 1}, {y, -1, 1},
Contours -> contourvalues,
ColorFunctionScaling -> False,
ColorFunction ->
ContourColors[contourvalues, ColorData["CoffeeTones"]],
PlotRange -> {-3, 3}]},
Frame -> True,
ImageSize -> 350]
];
(* Initial tangent plane with tangent point *)
tangentplane = {Green,
ParametricDraw3D[{x, y, 0}, {x, -.5, .5}, {y, -.5, .5}, Mesh -> 5,
MeshStyle -> Black],
Red, AbsolutePointSize[8], Opacity[1], Point[{0, 0, 0}]};
(* Calculation of coordinate values *)
calcAll[p_] := {x0, y0} = p;
calcAll[pt];
(* Display *)
Row[
{(* Contour plot of f with Locator *)
LocatorPane[Dynamic[pt, (pt = #; calcAll[pt]) &], contourplot,
Appearance ->
Graphics[CirclePoint[{0, 0}, 3, Black, Red], ImageSize -> 20]],
Spacer[10],
(* Surface plot with tangent plane *)
Draw3DItems[
{Opacity[.5, ColorData["CoffeeTones"][.5]],
ParametricDraw3D[{x, y, f[x, y]}, {x, -1, 1}, {y, -1, 1},
Mesh -> None],
Dynamic@(tangentplane // RotateOp[{{0, 0, 1}, normal[x0, y0]}] //
TranslateOp[{x0, y0, f[x0, y0]}])},
NeutralLighting[0, .5, .1],
NiceRotation,
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}} 2,
BoxRatios -> Automatic, Boxed -> False,
ImageSize -> 350]
}]
]
It is possible to use the second method on the larger xy-domain by scaling
the f function.
f[x_, y_] := (1 - x^2) (2 x - y^3)/20
gx[x_, y_] = D[{x, y, f[x, y]}, x];
gy[x_, y_] = D[{x, y, f[x, y]}, y];
normal[x_, y_] = gx[x, y]\[Cross]gy[x, y] // Simplify
Module[
{(* Primary dynamic variable *)
pt = {0, 0},
(* Dependent dynamic variables *)
x0, y0,
(* Other objects *)
calcAll, contourplot, tangentplane},
(* Back plot for the LocatorPane *)
contourplot = With[
{contourvalues = {-30, -20, -10, -5, -2, -1, -.5, 0, .5, 1, 2, 5,
10, 20, 30}/20.},
Draw2D[
{ContourDraw[f[x, y], {x, -2, 2}, {y, -2, 2},
Contours -> contourvalues,
ColorFunctionScaling -> False,
ColorFunction ->
ContourColors[contourvalues, ColorData["CoffeeTones"]],
PlotRange -> {-40, 40}]},
Frame -> True,
ImageSize -> 350]
];
(* Initial tangent plane with tangent point *)
tangentplane = {Green,
ParametricDraw3D[{x, y, 0}, {x, -1, 1}, {y, -1, 1}, Mesh -> 5,
MeshStyle -> Black],
Red, AbsolutePointSize[8], Opacity[1], Point[{0, 0, 0}]};
(* Calculation of coordinate values *)
calcAll[p_] := {x0, y0} = p;
calcAll[pt];
(* Display *)
Row[
{(* Contour plot of f with Locator *)
LocatorPane[Dynamic[pt, (pt = #; calcAll[pt]) &], contourplot,
Appearance ->
Graphics[CirclePoint[{0, 0}, 3, Black, Red], ImageSize -> 20]],
Spacer[10],
(* Surface plot with tangent plane *)
Draw3DItems[
{Opacity[.5, ColorData["CoffeeTones"][.5]],
ParametricDraw3D[{x, y, f[x, y]}, {x, -2, 2}, {y, -2, 2},
Mesh -> None],
Dynamic@(tangentplane // RotateOp[{{0, 0, 1}, normal[x0, y0]}] //
TranslateOp[{x0, y0, f[x0, y0]}])},
NeutralLighting[0, .5, .1],
NiceRotation,
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}} 3,
BoxRatios -> Automatic, Boxed -> False,
ImageSize -> 350]
}]
]
--
David Park
djmpark at comcast.net
http://home.comcast.net/~djmpark/
"m.g." <mg at michaelgamer.de> wrote in message
news:gdcdh5$fkf$1 at smc.vnet.net...
> Hello Group,
>
> I=B4m trying to visualize the tangential plane to a function f(x,y). I
> =B4ve done various attemps - none of them was successfull. Here an
> extract of my attempts:
>
> f[x_, y_] := (1 - x^2) (2 x - y^3)
> grad[x_, y_] := {2 (1 - x^2) - 2 x (2 x - y^3), -3 (1 - x^2) y^2}
>
> DynamicModule[{a = 1, b = 1, p, q, punkt},
> {Slider2D[Dynamic[{a, b}], {{-2, -2}, {2, 2}}],
> p = Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2}],
> punkt = Dynamic @ Graphics3D[{PointSize[Large], Red, Point[{a, b,
> f[a, b]}]}],
> q = Dynamic @ Plot3D[f[a, b] + grad[a, b].{x - a, y - b}, {x, -2,
> 2}, {y, -2, 2}]
> }
> ]
>
> Here the three parts I need (the surface of f, the tangential plane
> and the point "punkt" where the plane touches the surface) are shown,
> side by side.How can I manage it, that this three graphics are put
> together in ONE Graphics.
>
> The attempt
>
> DynamicModule[{a = 1, b = 1, p, q, punkt},
> {Slider2D[Dynamic[{a, b}], {{-2, -2}, {2, 2}}],
> punkt = Dynamic @ Graphics3D[{PointSize[Large], Red, Point[{a, b,
> f[a, b]}]}],
> q = Dynamic @ Plot3D[{f[x, y], f[a, b] + grad[a, b].{x - a, y - b}},
> {x, -2, 2}, {y, -2, 2}]
> }
> ]
>
> Changes f[x,y] (!!!), but only a and b are dynamically changing. How
> could this happen??
>
> Any hints appreciated.
>
> Greeting from Germany
>
> Mike
>