Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

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

Search the Archive

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
> 



  • Prev by Date: Re: Dynamic tangential plane - how?
  • Next by Date: Re: Dynamic tangential plane - how?
  • Previous by thread: Re: Dynamic tangential plane - how?
  • Next by thread: Re: Dynamic tangential plane - how?