1
$\begingroup$

I have this code that shows that the derivative is vertical to the surface. I need to change the point to an arrow that is vertical and moves as the point moves

f[x_, y_] = x + y - x y;
fx[x_, y_] = D[f[x, y], x];
fx[x_, y_] = Limit[(f[x + h, y] - f[x, y])/h, h -> 0];
fy[x_, y_] = D[f[x, y], y];
fy[x_, y_] = Limit[(f[x, y + h] - f[x, y])/h, h -> 0];
Manipulate[x0 = p[[1]]; y0 = p[[2]];
 Show[{Plot3D[{f[x, y], 
     f[x0, y0] + fx[x0, y0] (x - x0) + fy[x0, y0] (y - y0)}, {x, -5, 
     5}, {y, -5, 5}, BoxRatios -> {1, 1, 1}, 
    PlotRange -> {{-5, 5}, {-5, 5}, {-25, 25}}, 
    PlotStyle -> {Directive[Opacity[0.6]], 
      Directive[Orange, Opacity[0.6]]}, ViewPoint -> {2.5, -2, 1}, 
    ClippingStyle -> None], 
   Graphics3D[{PointSize[Large], 
     Point[{p[[1]], p[[2]], f[p[[1]], p[[2]]]}]}]}], {{p, {1, 
    1}}, {-1, -1}, {2, 2}}]

enter image description here

The change is so

enter image description here enter image description here

I tried with the ِِArrow

Graphics3D[{Red, Arrowheads[0.1], 
  Arrow[Tube[{{1, 1, -1}, {2, 2, 0}, {3, 3, -1}, {4, 4, 0}}, 0.05]]}]

But I did not get the desired result.

Here here YouTube is aware of the way to use the Mathematica but did not display all the code.

$\endgroup$
  • 1
    $\begingroup$ it is better to define functions using := and not = unless you have specific reason to use = $\endgroup$ – Nasser Sep 4 '17 at 5:18
  • 1
    $\begingroup$ Why are you defining fx and fy twice? $\endgroup$ – J. M. will be back soon Sep 4 '17 at 5:24
  • $\begingroup$ @Nasser OK, thanks, can it be an arrow instead of a point? $\endgroup$ – Emad kareem Sep 4 '17 at 5:24
  • 1
    $\begingroup$ Then, you should make up your mind and use either D[] or Limit[], but certainly not both. $\endgroup$ – J. M. will be back soon Sep 4 '17 at 6:22
  • 1
    $\begingroup$ What about: a/38900/5478 $\endgroup$ – Kuba Sep 4 '17 at 7:14
3
$\begingroup$

For a lecture on differential geometry I did once a demonstration like you intend to (without a tangent plane though). May be it will be of some use to you. Here it is. I inserted the radius-vector that describes your surface. Please have a look.

 Manipulate[
 R0 = {xx, yy, 5 + (5 + xx + yy - xx*yy)/4};
 e1 = D[R0, xx];
 e2 = D[R0, yy];
 n = Cross[e1, e2]/Sqrt[e1.e1*e2.e2 - e1.e2^2];

 rule = {xx -> X, yy -> Y};
 Which[
  showR == False && showBasis == False && showN == False,
  Show[{
     Plot3D[R0[[3]] /. {xx -> x, yy -> y}, {x, -5, 5}, {y, -5, 5}, 
      PlotStyle -> Directive[Opacity[0.3]], Ticks -> None, 
      ViewPoint -> {13, -6, 5}, PlotRange -> All, Boxed -> False, 
      AxesOrigin -> {0, 0, 0}, ColorFunction -> "SunsetColors"],
     Graphics3D[{Text[Style["x", Italic, 16], {4.2, 0, 0.2}], 
       Text[Style["y", Italic, 16], {0.1, 2.4, 0.2}], 
       Text[Style["z", Italic, 16], {0, 0, 6.7}]}],
     Graphics3D[{PointSize[0.015], Point[R0], Point[{X, Y, 0}]}]
     }, BoxRatios -> Automatic] /. rule,

  showR == True && showBasis == False && showN == False,
  Show[{
     Plot3D[R0[[3]] /. {xx -> x, yy -> y}, {x, -5, 5}, {y, -5, 5}, 
      PlotStyle -> Directive[Opacity[0.3]], Ticks -> None, 
      ViewPoint -> {13, -6, 5}, PlotRange -> All, Boxed -> False, 
      AxesOrigin -> {0, 0, 0}, ColorFunction -> "SunsetColors"],
     Graphics3D[{Arrowheads[0.03], Thick, Blue, 
        Arrow[{{0, 0, 0}, R0}]}] /. rule,
     Graphics3D[{Text[Style["x", Italic, 16], {4.2, 0, 0.2}], 
       Text[Style["y", Italic, 16], {0.1, 2.4, 0.2}], 
       Text[Style["z", Italic, 16], {0, 0, 6.7}]}],
     Graphics3D[{Text[Style["R", Bold, Blue, 16], 
        Mean[{{0, 0, 0}, R0 + {1, 0, 0}}]], PointSize[0.015], 
       Point[R0], Point[{X, Y, 0}]}]
     }, BoxRatios -> Automatic] /. rule,

  showR == True && showBasis == True && showN == False,
  Show[{
     Plot3D[R0[[3]] /. {xx -> x, yy -> y}, {x, -5, 5}, {y, -5, 5}, 
      PlotStyle -> Directive[Opacity[0.3]], Ticks -> None, 
      ViewPoint -> {13, -6, 5}, PlotRange -> All, Boxed -> False, 
      AxesOrigin -> {0, 0, 0}, ColorFunction -> "SunsetColors"],

     Graphics3D[{Arrowheads[0.03], Thick, Blue, 
        Arrow[{{0, 0, 0}, R0}]}] /. rule,

     Graphics3D[{Text[Style["x", Italic, 16], {4.2, 0, 0.2}], 
       Text[Style["y", Italic, 16], {0.1, 2.4, 0.2}], 
       Text[Style["z", Italic, 16], {0, 0, 6.7}]}],

     Graphics3D[{Arrowheads[0.03], Thick, Red, 
        Arrow[{R0, R0 + Normalize[e1]}],
        Arrowheads[0.03], Arrow[{R0, (R0 + Normalize[e2])}]
        }] /. rule,

     Graphics3D[{Text[
        Style["\!\(\*SubscriptBox[\(e\), \(1\)]\)", Bold, Red, 
         16], {R0 + Normalize[e1] + {0.2, 0, 0}}], 
       Text[Style["\!\(\*SubscriptBox[\(e\), \(2\)]\)", Bold, Red, 
         16], {R0 + Normalize[e2] + {0, 0.2, 0}}], Red, 
       Text[Style["R", Bold, Blue, 16], 
        Mean[{{0, 0, 0}, R0 + {1, 0, 0}}]], PointSize[0.015], 
       Point[R0], Point[{X, Y, 0}]}]
     }, BoxRatios -> Automatic] /. rule,

  showR == True && showBasis == True && showN == True,
  Show[{
     Plot3D[R0[[3]] /. {xx -> x, yy -> y}, {x, -5, 5}, {y, -5, 5}, 
      PlotStyle -> Directive[Opacity[0.3]], Ticks -> None, 
      ViewPoint -> {13, -6, 5}, PlotRange -> All, Boxed -> False, 
      AxesOrigin -> {0, 0, 0}, ColorFunction -> "SunsetColors"],

     Graphics3D[{Arrowheads[0.03], Thick, Blue, 
        Arrow[{{0, 0, 0}, R0}]}] /. rule,

     Graphics3D[{Text[Style["x", Italic, 16], {4.2, 0, 0.2}], 
       Text[Style["y", Italic, 16], {0.1, 2.4, 0.2}], 
       Text[Style["z", Italic, 16], {0, 0, 6.7}]}],

     Graphics3D[{Arrowheads[0.03], Thick, Red, 
       Arrow[{R0, R0 + Normalize[e1]}],
       Arrowheads[0.03], Arrow[{R0, (R0 + Normalize[e2])}],
       Arrowheads[0.03], Darker@Green, Arrow[{R0, R0 + n}]
       }],

     Graphics3D[{Text[
        Style["\!\(\*SubscriptBox[\(e\), \(1\)]\)", Bold, Red, 
         16], {R0 + Normalize[e1] + {0.2, 0, 0}}], 
       Text[Style["\!\(\*SubscriptBox[\(e\), \(2\)]\)", Bold, Red, 
         16], {R0 + Normalize[e2] + {0, 0.2, 0}}], 
       Text[Style["n", Bold, Darker@Green, 
         16], {R0 + n + {0, 0, 0.2}}], 
       Text[Style["R", Bold, Blue, 16], 
        Mean[{{0, 0, 0}, R0 + {1, 0, 0}}]], PointSize[0.015], 
       Point[R0], Point[{X, Y, 0}]}]



     }, BoxRatios -> Automatic] /. rule


  ],

 Column[{
   Row[{Control[{{X, 1.7}, 0, 4}], Spacer[30], 
     Control[{{Y, 0}, -2, 2}]}],
   Row[{
     Control[{{showR, False}, {True, False}}], Spacer[30], 
     Control[{{showBasis, False}, {True, False}}], Spacer[30],
     Control[{{showN, False}, {True, False}}]}]

   }, Alignment -> Center], 
 ControlType -> {Slider, Slider, Checkbox, Checkbox, Checkbox}

    SaveDefinitions -> True]

To see the vectors check the check boxes. The green arrow shows the unit normal vector, the red ones the tangent unit vectors. It should look like the following:

enter image description here

Have fun!

$\endgroup$
  • $\begingroup$ Thank you very much. This helps me a lot, are you studying differential geometry. $\endgroup$ – Emad kareem Sep 4 '17 at 9:40
  • $\begingroup$ @Emad kareem No. Differential geometry was a small part of the course of lectures on biomembranes I gave. $\endgroup$ – Alexei Boulbitch Sep 4 '17 at 11:05
  • $\begingroup$ Thank you so much. This helped me a lot. I am grateful to you. $\endgroup$ – Emad kareem Sep 4 '17 at 14:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.