3
$\begingroup$

I already found this Example but i want to add a description and the individual vectors as in the picture.

enter image description here

My approach so far:

TangentSurface[a_, b_] :=
 Module[{nv, pt, tangentsurface, func, grad, dx, dy, tanpt, x, y, z, 
   tanexpr, gr1, gr2, normalv, r = 0.7},
  func[x_, y_] := (y Cos[x] + x Sin[y])/5;

  dx[x_, y_] := D[func[x, y], x];
  dy[x_, y_] := D[func[x, y], y];
  grad[x_, y_] := {dx[x, y], dy[x, y], -1};

  nv = {dx[x, y], dy[x, y], -1};
  nv = nv/Norm[nv] /. {x -> a, y -> b};

  pt = {a, b, func[a, b]};

  tanpt = {x, y, z};
  gr1 = Plot3D[func[x, y], {x, -8, 8}, {y, -8, 8}, PlotPoints -> 100,  
    BaseStyle -> {FontSize -> 6}, PlotRange -> All, Boxed -> False, 
    PlotStyle -> None, Mesh -> 35, MeshStyle -> Red, 
    BoundaryStyle -> Red, Lighting -> "Neutral", 
    Axes -> {True, True, False}];

  tanexpr = (tanpt - (pt + .05 nv)).nv;
  tangentsurface = z /. First@Solve[tanexpr == 0, z];
  gr2 = Graphics3D[{RGBColor[96/255, 96/255, 96/255], 
     ControlActive[Opacity[1], Opacity[.9]], 
     Polygon[{{a + r, b + r, 
        tangentsurface /. {x -> a + r, y -> b + r}}, {a + r, b - r, 
        tangentsurface /. {x -> a + r, y -> b - r}}, {a - r, b - r, 
        tangentsurface /. {x -> a - r, y -> b - r}}, {a - r, b + r, 
        tangentsurface /. {x -> a - r, y -> b + r}}}]}];

  normalv = 
   Graphics3D[{Specularity[White, 50], RGBColor[.2, .4, 0], 
     Cylinder[{pt, pt - nv}, .07], Black, Specularity[White, 50], 
     Sphere[{a, b, func[a, b]}, .2]}];

  contourPotentialPlot = 
   ContourPlot[func[x, y], {x, -8, 8}, {y, -8, 8}, Contours -> 15, 
    Axes -> False, Frame -> False, ColorFunction -> None];
  level = -4;
  pts = Append[#, level] & /@ contourPotentialPlot[[1, 1]];
  cts = Cases[contourPotentialPlot, Line[l_], Infinity];
  cts3D = Graphics3D[GraphicsComplex[pts, {Opacity[.5], cts}]];

  Show[gr1, gr2, cts3D, PlotRange -> All, BoxRatios -> {1, 1, .5}, 
   FaceGrids -> {Bottom, Back, Left}, ViewPoint -> {2, -2, 1}, 
   ImageSize -> {800, 600}, Boxed -> False]]

Manipulate[
 TangentSurface[a, b],
 {{a, 1, "x"}, -8, 8},
 {{b, 1, "y"}, -8, 8},
 SaveDefinitions -> True]

enter image description here

$\endgroup$
  • 2
    $\begingroup$ Hi ! Please, add any relevant code to make this question self-contained. $\endgroup$ – Sektor Dec 29 '14 at 8:57
  • $\begingroup$ Hey, hopefully it is now clear what I mean. $\endgroup$ – Maxwell Dec 29 '14 at 11:42
  • $\begingroup$ Yeap, it's clear. But ... what difficulties have you found while trying to do this? Or is this a "code it for me" question? $\endgroup$ – Dr. belisarius Dec 29 '14 at 12:20
  • $\begingroup$ No, i only need a hint how i can determine the red circled point in Mathematica. $\endgroup$ – Maxwell Dec 29 '14 at 12:29
  • $\begingroup$ Seems like you got everything in place already. gr2 contains all neccessary information. $\endgroup$ – Yves Klett Dec 29 '14 at 12:38