CALCULUS III

Manipulate[{ParametricPlot3D[{{(10^\[Alpha] - (10 - u)^\[Alpha])/

     Gamma[\[Alpha] + 1], u, u + 0.5*Sin[u]}, {(

     10^\[Alpha] - (10 - u)^\[Alpha])/Gamma[\[Alpha] + 1], 0, 

     u + 0.5*Sin[u]}, {0, u, u + 0.5*Sin[u]}}, {t, 0, 10}, {u, 0, 10},

    BoxRatios -> {1, 1, 1}, BoundaryStyle -> Directive[Blue, Thick]], 

  Plot[u + 0.5*Sin[u], {u, 0, 10}, Filling -> Bottom, 

   AxesLabel -> "f(t)=t+0.5Sin[t]"], 

  Plot[(10^\[Alpha] - (10 - u)^\[Alpha])/

   Gamma[\[Alpha] + 1], {u, 0, 10}, PlotRange -> {0, 10}, 

   AxesLabel -> 

    "g(t)=\!\(\*FractionBox[\(\*SuperscriptBox[\(10\), \(\[Alpha]\)] \

- \*SuperscriptBox[\((10 - u)\), \(\[Alpha]\)]\), \(\(\\\ \)\(\

\[CapitalGamma][\[Alpha] + 1]\)\)]\)"], 

  ParametricPlot[{(10^\[Alpha] - (10 - u)^\[Alpha])/

    Gamma[\[Alpha] + 1], m*(u + 0.5*Sin[u])}, {u, 0, 10}, {m, 0, 1}, 

   PlotRange -> {0, 10}, 

   PlotLegends -> {"Shadow on the wall"}]}, {\[Alpha], 0, 1}]

=======================================================

===========================================================

Manipulate[
ListPointPlot3D[{Table[{(10^\[Alpha] - (10 - u)^\[Alpha])/
    Gamma[\[Alpha] + 1], u, u + 0.5*Sin[u]}, {u, 0, 10, 0.1}],
  Table[{(10^\[Alpha] - (10 - u)^\[Alpha])/Gamma[\[Alpha] + 1], 0,
    u + 0.5*Sin[u]}, {u, 0, 10, 0.1}],
  Table[{0, u, u + 0.5*Sin[u]}, {u, 0, 10, 0.1}]}, Filling -> Bottom,
  BoxRatios -> {10, 10, 6}, AxesLabel -> {g, t, "f(t)"}], {\[Alpha],
  0.001, 1}]

===========================================================

================================================================

Manipulate[

Switch[views,
 
  uno, Pane[Grid[{
    {Text@
      Row[{"surface area S \[TildeTilde] \[Sum] ",
        Style["\!\(\*SubscriptBox[\(C\), \
\(k\)]\)\[Times]\!\(\*SubscriptBox[\(W\), \(k\)]\)", Italic], ","},
        BaseStyle -> {Bold, 15}]},
    {Text@
      Row[{"where ",
        Style["\!\(\*SubscriptBox[\(C\), \(k\)]\) and \
\!\(\*SubscriptBox[\(W\), \(k\)]\)", Italic],
        " are the circumference and width of the ",
        Style["\!\(\*SuperscriptBox[\(k\), \(th\)]\)", Italic],
        " band."}, BaseStyle -> {Bold, 15}]},
    {Text@
      Row[{ "S = ",
        TraditionalForm@
          HoldForm[\[Integral]2 \[Pi] y \[DifferentialD] s]},
        BaseStyle -> {Bold, 14}]},
    {Text@Row[{" = ", TraditionalForm@HoldForm[\!\(
\*SubsuperscriptBox[\(\[Integral]\), \(a\), \(b\)]\(2  \[Pi]\ y
\*SqrtBox[\(1 +
\*SuperscriptBox[\((
\*FractionBox[\(d y\), \(d x\)])\), \(2\)]\)] \[DifferentialD]\
              x\)\)], "."}, BaseStyle -> {Bold, 14}]},
    {Show[{movable = True; rotatable = True; clickable = True;
        selectable = False;
        If[xcoord && strip, Graphics3D[{
          {Dashed, Thick,
            Line[{{aa, 0, 0}, {aa, 0, Sqrt[aa] + Sin[aa]}}]},
          {Dashed, Thick,
            Line[{{aa + 0.5, 0, 0}, {aa + 0.5, 0,
              Sqrt[aa + 0.5] + Sin[aa + 0.5]}}]},
         
          Text[Style[TraditionalForm@Subscript[x, k - 1],
            Bold], {aa - 0.4, 0, -.5}],
         
          Text[Style["\!\(\*SubscriptBox[\(x\), \(k\)]\)", Bold,
            Italic], {aa + 0.8, 0, -.5}],
         
          Text[Style["P", 12, Bold, Red], {aa, 0,
            Sqrt[aa] + Sin[aa] + .6}],
         
          Text[Style["Q", 12, Bold, Red], {aa + 0.5, 0,
            Sqrt[aa + 0.5] + Sin[aa + 0.5] + .7}]
          }], {}],
        Graphics3D
        [{
          {EdgeForm[None],
          Polygon[
            Prepend[
            Table[{4.5, (Sqrt[4.5] +
                  Sin[4.5]) Sin[-\[Theta]], (Sqrt[4.5] +
                  Sin[4.5]) Cos[-\[Theta]]}, {\[Theta],
              0, \[Theta]n, \[Pi]/36}], {4.5, 0, 0}]]},
          {EdgeForm[None],
          Polygon[
            Prepend[
            Table[{14, (Sqrt[14] +
                  Sin[14]) Sin[-\[Theta]], (Sqrt[14] +
                  Sin[14]) Cos[-\[Theta]]}, {\[Theta],
              0, \[Theta]n, \[Pi]/36}], {14, 0, 0}]]}
          }, BaseStyle -> If[trans, Opacity[0.5], Opacity[.9]]],
        curve, axis,
        If[strip,
        RevolutionPlot3D[
          Sqrt[x] + Sin[x], {x, aa, aa + 0.5}, {\[Theta],
          0, \[Theta]n}, RevolutionAxis -> {1, 0, 0}, Mesh -> None,
          BoundaryStyle -> Directive[Red, Thick],
          PlotStyle -> {Opacity[1], Red},
          PerformanceGoal -> "Quality"], {}],
        RevolutionPlot3D[
        Sqrt[x] + Sin[x], {x, 4.5, 14}, {\[Theta], 0, \[Theta]n},
        RevolutionAxis -> {1, 0, 0}, Mesh -> None,
        PlotStyle -> If[trans, Opacity[0.5], Opacity[0.9]],
        PerformanceGoal -> "Quality"]}, Boxed -> False,
      ViewPoint -> Front, ImageSize -> {500, 300},
      PlotRange -> {{0, 15}, {-6, 6}, {-6, 6}}]}
    }], {500, 400}
  ],
 
  dos, Pane[Grid[{
    {Text@
      TraditionalForm@
        Row[{"circumference of a circle = ", 2 \[Pi] y,
          " \[TildeTilde] ", 2 \[Pi],
          HoldForm[(f[Subscript[x, k - 1]] + f[Subscript[x, k]])/(
          "2")]}, BaseStyle -> {Bold, 14}]},
    {Show[{graphics1, movable = False; clickable = False;
        rotatable = True;
        RevolutionPlot3D[Sqrt[x], {x, 1, 3}, {\[Theta], 0, \[Theta]n},
          RevolutionAxis -> {1, 0, 0}, Mesh -> None,
        PlotStyle -> If[trans, Opacity[0.5], Opacity[0.9]],
        Axes -> False, PerformanceGoal -> "Quality"],
        If[xcoord, Graphics3D[{
          {Dashed, Thick, Red, Line[{{1, 0, 0}, {1, 0, 1}}]},
          {Dashed, Thick, Red, Line[{{3, 0, 0}, {3, 0, Sqrt[3]}}]},
          Text["\!\(\*SubscriptBox[\(x\), \(k - 1\)]\)", {1, 0, -.5}],
         
          Text["\!\(\*SubscriptBox[\(x\), \(k\)]\)", {3,
            0, -.5}]}], {}]
        }, Boxed -> False, ViewPoint -> Front,
      ImageSize -> {500, 300},
      PlotRange -> {{0, 4}, {-3, 3}, {-3, 3}}]}
   
    }], {500, 400}
  ],
 
  tres, Pane[Grid[{
    {Text@Row[{"band width = arc(PQ)"}, BaseStyle -> {Bold, 14}]},
    {Text@
      Style[Row[{"  |PQ| = ",
          Sqrt[Superscript[
            Subscript[Row[{"\[CapitalDelta]", Style["x", Italic]}],
              Style["k", Italic]], 2] +
            Superscript[
            Subscript[Row[{"\[CapitalDelta]", Style["y", Italic]}],
              Style["k", Italic]], 2]]}], Bold, 14]},
    {Show[{movable = False; rotatable = False; selectable = True;
        clickable = False; graphics2,
        Plot[(-(x^2) + 10), {x, 0, 3},
        PlotRange -> {{0, 3.5}, {0, 12}}, Axes -> False]
        }, ImageSize -> {300, 200},
      ImagePadding -> {{60, 60}, {10, 10}}]}
    }, Alignment -> Center], {500, 400}]
  ],

{{\[Theta]n, \[Pi], "rotate"}, 0.001, 2 \[Pi],
  Enabled -> Dynamic[rotatable]},
{{aa, 8, "strip location"}, 4.5, 13.5,
  Enabled -> Dynamic[strip && movable]},
Grid[{{
    Control[{{xcoord, True, "x coordinates"}, Checkbox,
      Enabled -> Dynamic[strip && Not[selectable]]}], Spacer[20],
    Control[{{trans, True, "transparent"}, Checkbox,
      Enabled -> Dynamic[strip && Not[selectable]]}], Spacer[20],
    Control[{{strip, True, "strip"}, Checkbox,
      Enabled -> Dynamic[clickable]}]
    }}],
{{views, uno, "views"}, {uno -> "solid", dos -> "frustrum of a cone",
    tres -> "arc length"}, ControlType -> PopupMenu},
Initialization :> (
  curve =
    ParametricPlot3D[{x, 0, Sqrt[x] + Sin[x]}, {x, 4.5, 14},
    PlotStyle -> {Black, AbsoluteThickness[3]}, Axes -> False,
    Boxed -> False];
  curve2 =
    ParametricPlot3D[{x, 0, Sqrt[x]}, {x, 1, 3},
    PlotStyle -> {Black, AbsoluteThickness[3]}, Axes -> False,
    Boxed -> False];
  axis = Graphics3D[{Line[{{0, 0, 0}, {20, 0, 0}}],
      Line[{{0, 0, -4}, {0, 0, 4}}],
      Line[{{4.5, 0, -.05}, {4.5, 0, .05}}],
      Line[{{14, 0, -.05}, {14, 0, .05}}],
      Text[Style["a", Italic], {4.5, 0, -2}],
      Text[Style["b", Italic], {14, 0, -2}],
      Text[Style["x", Italic], {20.7, 0, 0}],
      Text[Style["y", Italic], {0, 0, 4.7}],
      Text[
      Row[{Style["y", 15, Italic], " = ", Style["f", 15, Italic],
        "(", Style["x", 15, Italic], ")"}], {6, 0, 4}]}];
  graphics1 = Graphics3D[{
      Text[Style["x", Italic], {5.3, 0, 0}],
      Line[{{0, 0, 0}, {5, 0, 0}}],
      {Dashed, Thick, Line[{{2, 0, 0}, {2, 0, Sqrt[2]}}]},
      Text[Style["P", 12, Bold, Red], {1, 0, 1.5}],
      Text[Style["Q", 12, Bold, Red], {3, 0, Sqrt[3] + .4}],
      Text[Style["y", 15, Bold, Italic, Red], {2.3, 0, .5}],
      Text[Row[{"\[CapitalDelta]", Style["x", Italic]}], {2, 0, 2}],
      Polygon[
      Prepend[Table[{2, (Sqrt[2]) Sin[-\[Theta]], (Sqrt[
            2]) Cos[-\[Theta]]}, {\[Theta], 0, 2 \[Pi], \[Pi]/
          36}], {2, 0, 0}]]
      }, BaseStyle -> Bold];
  graphics2 = Graphics[{
      {Dashed, Thick, Line[{{0.5, 3.75}, {0.5, 39/4}}]},
      {Dashed, Thick, Line[{{0.5, 3.75}, {2.5, 3.75}}]},
      {Thick, Line[{{0.5, 39/4}, {2.5, 3.75}}]},
      Line[{{0.5, 4.5}, {0.6, 4.5}}],
      Line[{{0.6, 3.75}, {0.6, 4.5}}],
      Text[Style["P", 17, Bold, Red], {0.5, 10.0}],
      Text[Style["Q", 17, Bold, Red], {2.67, 3.75}],
      Text[
      Style[TraditionalForm@
        Row[{L, " = ",
          HoldForm[
            Sqrt[(\[CapitalDelta] Subscript[x,
              k])^2 + (\[CapitalDelta] Subscript[y, k])^2]]}], 13,
        Bold, Red], {3, 9.3}],
      Text[
      Style[Row[{\[CapitalDelta], Subscript[x, k]}], 15, Bold,
        Red], {1.5, 4}],
      Text[
      Style[Row[{\[CapitalDelta], Subscript[y, k]}], 15, Bold,
        Red], {0.2, 6.5}],
      Arrow[{{1.7, 9}, {1.2, 8}}]
      }, BaseStyle -> Bold]
  )]

=================================================================

Manipulate[Pane[
 
  Switch[fcns,
  reg1,
  f[x_] := 2 Sin[x] + 4;
  g[x_] := x/4,
  reg2,
  f[x_] := x^2/8 + 1;
  g[x_] := -x/4 + 1
  ];
 
  yrotate = -1;
 
  xmin = Pi/8;
  xmax = 2 Pi;
 
  ymax = 8;
  ymin = -ymax;
 
  $$viewangle = theview;  (* 1: Front, 2: Back *)
  viewlist = Part[{{0.5, 0.5, 1.5}, {0.5, 0.5, -1.5}}, $$viewangle];
 
  activestyle = {PlotPoints -> 16, MaxRecursion -> 0, Mesh -> False};
 
  inactivestyle = {PlotPoints -> 25, MaxRecursion -> 1, Mesh -> False,
    PlotStyle ->
    If[MemberQ[plotopts, translucent], Opacity[0.5], Opacity[1]]};
 
 
  outsidesurface[thetamax_, opts___] :=
  ParametricPlot3D[{u, (f[u] - yrotate) Cos[v] +
      yrotate, (f[u] - yrotate) Sin[v]}, {u, xmin, xmax}, {v, 0,
    thetamax}, opts];
 
  insidesurface[thetamax_, opts___] :=
  ParametricPlot3D[{u, (g[u] - yrotate) Cos[v] +
      yrotate, (g[u] - yrotate) Sin[v]}, {u, xmin, xmax}, {v, 0,
    thetamax}, opts];
 
  a = xmin; b = xmax;
  endmin[thetamax_, opts___] :=
  If[Min[f[a] - yrotate, g[a] - yrotate] ==
    Max[f[a] - yrotate, g[a] - yrotate], {},
         
    ParametricPlot3D[{a, r Cos[t] + yrotate, r  Sin[t]}, {r,
      Min[f[a] - yrotate, g[a] - yrotate],
                Max[f[a] - yrotate, g[a] - yrotate]}, {t, 0,
      thetamax}, opts]];
  endmax[thetamax_, opts___] :=
  If[Min[f[b] - yrotate, g[b] - yrotate] ==
    Max[f[b] - yrotate, g[b] - yrotate], {},
         
    ParametricPlot3D[{b, r Cos[t] + yrotate, r  Sin[t]}, {r,
      Min[f[b] - yrotate, g[b] - yrotate],
                Max[f[b] - yrotate, g[b] - yrotate]}, {t, 0,
      thetamax}, opts]];
 
  startregion[opts___] :=
  ParametricPlot3D[{x, ((g[x] - f[x]) t + f[x]), 0}, {x, xmin,
    xmax}, {t, 0, 1}, opts];
 
  (* Rotating Region *)
  rotatingregion[thetamax_, opts___] := Module[{},
    startlist = {x, ((g[x] - f[x]) t + f[x]) - yrotate, 0};
    rotmatrix = {{1, 0, 0}, {0, Cos[thetamax], -Sin[thetamax]}, {0,
      Sin[thetamax], Cos[thetamax]}};
    plotlist = rotmatrix.startlist;
   
    region =
    ParametricPlot3D[{plotlist[[1]], plotlist[[2]] + yrotate,
      plotlist[[3]]}, {x, xmin, xmax}, {t, 0, 1}, opts]
    ];
 
  ThreeAxes =
  ParametricPlot3D[{{xmax*t + xmin/2 (1 - t), 0, 0}, {0,
      ymax/2*t + ymin/2 (1 - t), 0}, {0, 0,
      ymax/2*t + ymin/2 (1 - t)}}, {t, 0, 1}, PlotStyle -> Black];
 
  revaxis =
  ParametricPlot3D[{t, yrotate, 0}, {t, xmin, xmax},
    PlotStyle -> Red];
 
 
  regionplot = Show[
    Plot[{f[x], g[x]}, {x, a, b}, PlotStyle -> Black, Filling -> True,
      FillingStyle -> Lighter[Purple, 0.5]],
    Graphics[{Red, Line[{{a, yrotate}, {b, yrotate}}]}],
    AspectRatio -> Automatic, ImageSize -> 150, 
    AxesLabel -> {Text@Style["x", 16, Italic],
      Text@Style["y", 16, Italic]}, PlotRange -> {-6, 6}];
 
 
  Grid[{{
    Deploy[
      Column[{Text@Style["region to rotate around", "Label", 14],
        Text@Style[Row[{"the line ", Style[y, Italic], " = -1"}],
          "Label", 14],
        regionplot
        }]],
   
    Show[
      If[th ==
        0, {}, {outsidesurface[th,
        ControlActive[activestyle, inactivestyle]],
        insidesurface[th, ControlActive[activestyle, inactivestyle]],
        endmin[th, ControlActive[activestyle, inactivestyle]],
        endmax[th, ControlActive[activestyle, inactivestyle]]}],
      startregion[ControlActive[activestyle, inactivestyle]],
      rotatingregion[th, ControlActive[activestyle, inactivestyle]],
      If[MemberQ[plotopts, showaxes], {ThreeAxes, revaxis}, {}],
      Axes -> MemberQ[plotopts, showaxes],
      PlotRange -> {{-1, xmax}, {ymin, ymax}, {ymin, ymax}},
      Boxed -> False, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}},
      ViewVertical -> {0, 1, 0}, ViewPoint -> viewlist,
      AxesLabel -> {Text@Style["x", 16, Italic],
        Text@Style["y", 16, Italic], Text@Style["z", 16, Italic]},
      ImageSize -> 258]
    }}], ImageSize -> {450, 400}],

{{fcns, reg1, ""}, {reg1 -> "region 1", reg2 -> "region 2"},
  ControlPlacement -> Top},
{{plotopts, {translucent, showaxes}, Spacer[295]}, {translucent,
  showaxes -> "show axes"}, ControlPlacement -> Bottom,
  ControlType -> CheckboxBar},
"",
{{theview, 1, ""}, {1 -> "front", 2 -> "back"},
  ControlPlacement -> Right, Appearance -> "Vertical"},
"",
Style["     \[Theta]", 14],
{{th, 0, ""}, 2 Pi, 0, ControlType -> VerticalSlider,
  ControlPlacement -> Right},
ControlPlacement -> Right,

TrackedSymbols :> {th, plotopts, theview, fcns},
AutorunSequencing -> {3, 4}]

=============================================================

Manipulate[
Show[{
  curverev1, curve2low,
  Graphics3D[
    {
    Line[{{1, 0, -.04}, {1, 0, .04}}],
    Line[{{4, 0, -.04}, {4, 0, .04}}],
    {Text[
      Row[{Style["y", Italic], " = ", Style["f", Italic], "(",
        Style["x", Italic], ")"}], {4.75, 0, 1.2}],
      Text[
      Style[Row[{Style["y", Italic], " = ", Style["g", Italic], "(",
          Style["x", Italic], ")"}], 14], {4.75, 0, .55}],
      If[\[Theta]1 < \[Pi]/2 || (Not[solidrev1] && \[Theta]1 > \[Pi]),
        Text[Style["a", Italic], {.95, 0, -.25}], {}],
      If[\[Theta]1 < \[Pi]/2 || (Not[solidrev1] && \[Theta]1 > \[Pi]),
        Text[Style["b", Italic], {4, 0, -.25}], {}],
      Text[Style["x", Italic], {5.2, 0, 0}],
      Text[Style["y", Italic], {0, 0, 1.5}]},
    {RGBColor[0, 0, 0], Line[{{0, 0, 0}, {5, 0, 0}}],
      Line[{{0, 0, -4}, {0, 0, 4}}]},
    If[(regionrev1 && Not[solidrev1]) || (regionrev1 &&
        solidrev1 && \[Theta]1 < 2 \[Pi]), {EdgeForm[None],
      LightBlue,
      Polygon[Join[
        Table[{x, (.25 Sin[2 x + 1] +
              1) Sin[-\[Theta]1], (.25 Sin[2 x + 1] +
              1) Cos[-\[Theta]1]}, {x, 1, 4, .015}],
        Table[{x, (.15 Cos[2 x + 1] + .5) Sin[-\[Theta]1], (.15 Cos[
                2 x + 1] + .5) Cos[-\[Theta]1]}, {x, 4,
          1, -.015}]]]}, {}],
    If[solidrev1, {EdgeForm[None],
      If[washtran, Opacity[.75], Opacity[1]],
      Polygon[Join[
        Table[{4, (.25 Sin[9] + 1) Sin[-\[Theta]], (.25 Sin[9] +
              1) Cos[-\[Theta]]}, {\[Theta],
          0, \[Theta]1, \[Pi]/100}],
        Table[{4, (.15 Cos[9] + .5) Sin[-\[Theta]], (.15 Cos[
                9] + .5) Cos[-\[Theta]]}, {\[Theta], \[Theta]1,
          0, -\[Pi]/100}]]]}, {}],
    If[solidrev1, {EdgeForm[None],
      If[washtran, Opacity[.75], Opacity[1]],
      Polygon[Join[
        Table[{1, (.25 Sin[3] + 1) Sin[-\[Theta]], (.25 Sin[3] +
              1) Cos[-\[Theta]]}, {\[Theta],
          0, \[Theta]1, \[Pi]/100}],
        Table[{1, (.15 Cos[3] + .5) Sin[-\[Theta]], (.15 Cos[
                3] + .5) Cos[-\[Theta]]}, {\[Theta], \[Theta]1,
          0, -\[Pi]/100}]]]}, {}]
    }],
  If[solidrev1,
    RevolutionPlot3D[.25 Sin[2 t + 1] + 1, {t, 1, 4}, {\[Theta],
      0, \[Theta]1}, RevolutionAxis -> {1, 0, 0},
    PerformanceGoal -> "Quality", Mesh -> None,
    PlotStyle -> If[washtran, Opacity[.5], Opacity[1]]], {}],
  If[solidrev1 && washtran,
    RevolutionPlot3D[.15 Cos[2 t + 1] + .5, {t, 1, 4}, {\[Theta],
      0, \[Theta]1}, RevolutionAxis -> {1, 0, 0},
    PerformanceGoal -> "Quality", Mesh -> None,
    PlotStyle -> Opacity[1]], {}]
  }, PlotRange -> {{0, 5}, {-2, 2}, {-1.3, 1.3}},
  AxesOrigin -> {0, 0, 0}, Boxed -> False,
  Axes -> {None, None, Automatic}, ViewPoint -> {1.5, -4, 0},
  Background -> White, ImageSize -> {450, 450},
  Ticks -> {{1, 4}, None, None}, BaseStyle -> 14]
,
Delimiter,
Grid[{{
    Control[{{regionrev1, True, "region"}, Checkbox}],
    Spacer[15],
    Control[{{solidrev1, True, "solid"}, Checkbox}],
    Spacer[15],
    Control[{{washtran, False, "transparent"}, Checkbox}],
    }}],
{{\[Theta]1, \[Pi], "rotate"}, .0001, 2 \[Pi],
  Enabled -> Dynamic[(regionrev1 || solidrev1)]},
Initialization :> (curve2low =
    ParametricPlot3D[{x, 0, .15 Cos[2 x + 1] + .5}, {x, .5, 4.5},
    PlotStyle -> {Black, AbsoluteThickness[1.75]}];
  curverev1 =
    ParametricPlot3D[{x, 0, .25 Sin[2 x + 1] + 1}, {x, .5, 4.5},
    PlotStyle -> {Black, AbsoluteThickness[1.75]}]),
SaveDefinitions -> True, AutorunSequencing -> {2, 4}]

=======================================================

Manipulate[
x0 = pt[[1]]; y0 = pt[[2]];
Show[
  Plot3D[f[x, y], {x, 0, 5}, {y, 0, 5}, MaxRecursion -> 2,
  Ticks -> None, PlotRange -> {{0, 5}, {0, 5}, {0, 4}},
  SphericalRegion -> True,
  AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, BoxRatios -> Automatic,
    Mesh -> False, PlotStyle -> Opacity[.6], BoundaryStyle -> None,
  Boxed -> False, PlotLabel -> Row[{
      "Taylor series for a function \!\(\*FormBox[\(f(x, y)\),
TraditionalForm]\) near a point \
\!\(\*FormBox[\((\*SubscriptBox[\(x\), \(0\)], \*SubscriptBox[\(y\), \
\(0\)])\),
TraditionalForm]\)"
      }]
  ],
  Graphics3D[{Red, Sphere[{x0, y0, f[x0, y0]}, .04]}],
  If[type == "first-order",
  Plot3D[
    f[x0, y0] + fx[x0, y0] (x - x0) + fy[x0, y0] (y - y0), {x,
    x0 - len, x0 + len}, {y, y0 - len, y0 + len}, Mesh -> False,
    PlotPoints -> 3],
  If[type == "second-order",
    Plot3D[
    f[x0, y0] + fx[x0, y0] (x - x0) +
      fy[x0, y0] (y - y0) + .5 fxx[x0, y0] (x - x0)^2 + .5 fyy[x0,
        y0] (y - y0)^2 + fxy[x0, y0] (x - x0) (y - y0), {x, x0 - len,
      x0 + len}, {y, y0 - len, y0 + len}, Mesh -> False],
    Plot3D[
    f[x0, y0] + fx[x0, y0] (x - x0) +
      fy[x0, y0] (y - y0) + .5 fxx[x0, y0] (x - x0)^2 + .5 fyy[x0,
        y0] (y - y0)^2 + fxy[x0, y0] (x - x0) (y - y0)
      + (1/6)*(
        fxxx[x0, y0] (x - x0)^3
        + 3 fxxy[x0, y0] (x - x0)^2 (y - y0)
        + 3 fxyy[x0, y0] (x - x0) (y - y0)^2
        + fyyy[x0, y0] (y - y0)^3
        ), {x, x0 - len, x0 + len}, {y, y0 - len, y0 + len},
    Mesh -> False]
    ]
  ], ImageSize -> {400, 400}
  ],
{{pt, {2.565, 2.585},
  Row[{"(", Subscript["x", 0], ", ", Subscript["y", 0], ")"}]}, {0,
  0}, {5, 5}},
{{type, "first-order", ""}, {"first-order", "second-order",
  "third-order"}},
ControlPlacement -> {Left, Top}, SaveDefinitions -> True,
TrackedSymbols -> True]

===============================================================

Manipulate[

rnd[x_] := If[Accuracy[x] == Infinity, x, Round[x, 0.01]];
pitest[x_] := Or[Head[x/Pi] === Integer, Head[x/Pi] === Rational];

DynamicModule[{surfacegraph, anglegraph, contourgraph, pointgraph,
  ff , xmin, xmax, ymin, ymax, zmin, zmax, xgrid1, ygrid1,
  thept = ptctrl, angpt = {Cos[angctrl], Sin[angctrl]},
  ang = angctrl},
 
  Switch[fcn,
  f1,
  ff[x_, y_] := 4 - x^2 - y^2;
  xmin = -2; xmax = 2; ymin = -2; ymax = 2; zmin = 0; zmax = 4.1;
  {xgrid1, ygrid1} = {1/2, 1/2},
  f2,
  ff[x_, y_] := (y^2 - x^2)/2;
  xmin = -2; xmax = 2; ymin = -2; ymax = 2; zmin = -2.1; zmax = 2.1;
  {xgrid1, ygrid1} = {1/2, 1/2},
  f3,
  ff[x_, y_] := x Cos[2 y];
  xmin = -3; xmax = 3; ymin = -Pi; ymax = Pi; zmin = -3.1; zmax = 3.1;
  {xgrid1, ygrid1} = {1, Pi/12},
  f4,
  ff[x_, y_] := Sin[x] Cos[y];
  xmin = -Pi; xmax = Pi; ymin = -Pi; ymax = Pi; zmin = -1.1;
  zmax = 1.1;
  {xgrid1, ygrid1} = {Pi/12, Pi/12},
  f5,
  ff[x_, y_] := (x + y)/2;
  xmin = -2; xmax = 2; ymin = -2; ymax = 2; zmin = -2.1; zmax = 2.1;
  {xgrid1, ygrid1} = {1/2, 1/2}
  ];
  {xgrid, ygrid} =
  If[MemberQ[opts, gridsnap], {xgrid1, ygrid1}, {0.001, 0.001}];
 
  surfacegraph[thept_, angpt_] :=
  Show[
    Plot3D[ff[x, y], {x, xmin, xmax}, {y, ymin, ymax},
    PlotStyle -> Opacity[ControlActive[1, 0.8]], Mesh -> False,
    PlotRange -> {{xmin, xmax}, {ymin, ymax}, {zmin, zmax}},
    PerformanceGoal -> "Speed"],
    Graphics3D[{{Darker[Green, 0.5], PointSize[0.02],
      Point[{thept[[1]], thept[[2]], ff[thept[[1]], thept[[2]]]}]},
      If[MemberQ[opts,
        showgrad], {{Blue, Thick,
        Line[{{thept[[1]], thept[[2]], zmin},
          Append[thept + D[ff[x, y], {{x, y}}] /. {x -> thept[[1]],
              y -> thept[[2]]}, zmin]}]},
        {Blue, PointSize[0.025],
        Point[{thept[[1]], thept[[2]], zmin}]}}, {}],
      If[MemberQ[opts, showunit],
      {{Red, PointSize[0.025],
        Point[{thept[[1]], thept[[2]], zmin}]}, {Red, Thick,
        Line[{{thept[[1]], thept[[2]],
            zmin}, {thept[[1]] + angpt[[1]], thept[[2]] + angpt[[2]],
            zmin}}]}}, {}],
      {Gray, Opacity[ControlActive[1, 0.3]],
      Polygon[{{xmin, ymin, zmin}, {xmin, ymax, zmin}, {xmax, ymax,
          zmin}, {xmax, ymin, zmin}}]}
      }],
    ParametricPlot3D[{angpt[[1]] t + thept[[1]],
      angpt[[2]] t +
      thept[[2]], (D[ff[x, y], {{x, y}}].angpt /. {x -> thept[[1]],
          y -> thept[[2]]}) t + f[thept[[1]], thept[[2]]]}, {t, -1,
      1}, PlotStyle -> Darker[Green, 0.5], MaxRecursion -> 0,
    PerformanceGoal -> "Speed"],
    AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, ImageSize -> 195,
    BoxRatios -> {xmax - xmin, ymax - ymin, zmax - zmin},
    PlotRange -> {{xmin, xmax}, {ymin, ymax}, {zmin, zmax}},
    Boxed -> False
    ];
 
  anglegraph[angpt_, opts___] :=
  Graphics[{{Lighter[Gray, 0.5],
      Circle[{0, 0}, 1]}, {Lighter[Gray, 0.5], Line[{{0, 0}, {1, 0}}]},
    {Red, Thick, Arrowheads[Large], Arrow[{{0, 0}, angpt}]}},
    PlotRange -> 1.2, ImageSize -> 100, opts];
 
  contourgraph[thept_, angpt_] :=
  Show[ContourPlot[ff[x, y], {x, xmin, xmax}, {y, ymin, ymax},
    Contours -> ControlActive[3, Automatic],
    FrameTicks -> {Table[
        n, {n, xmin, xmax, If[pitest[xgrid1], 3 xgrid1, xgrid1]}],
      Table[n, {n, ymin, ymax,
        If[pitest[ygrid1], 3 ygrid1, ygrid1]}], True, True},
    PerformanceGoal -> "Speed"],
    Graphics[{
      If[MemberQ[opts,
        showgrad], {{Blue, PointSize[0.03], Point[thept]}, {Blue,
        Thick, Arrowheads[Medium],
        Arrow[{thept,
          thept + D[ff[x, y], {{x, y}}] /. {x -> thept[[1]],
            y -> thept[[2]]}}]}}, {}],
      If[MemberQ[opts,
        showunit], {{Lighter[Red, 0.2], Thick, Arrowheads[Medium],
        Arrow[{thept, thept + angpt}]}, {Red, PointSize[0.03],
        Point[thept]}}, {}]}], ImageSize -> 180,
    AspectRatio -> Automatic];
 
  pointgraph[thept_, angpt_, opts___] :=
  Graphics[{{Lighter[Red, 0.5], Thick, Arrowheads[Medium],
      Arrow[{thept, thept + angpt}]}, {Red, PointSize[0.05],
      Point[thept]}}, Axes -> True,
    PlotRange -> {{xmin, xmax}, {ymin, ymax}},
    AspectRatio -> Automatic, opts,
    GridLines -> {Table[{n, Lighter[Gray, 0.5]}, {n, xmin, xmax,
        xgrid1}],
      Table[{n, Lighter[Gray, 0.5]}, {n, ymin, ymax, ygrid1}]},
    Ticks -> {Table[
      n, {n, xmin, xmax, If[pitest[xgrid1], 3 xgrid1, xgrid1]}],
      Table[n, {n, ymin, ymax,
        If[pitest[ygrid1], 3 ygrid1, ygrid1]}]},
    BaseStyle -> {10, "Label"}, ImageSize -> 150];
 
  Column[{
    Grid[{
      {Grid[{{Deploy@LocatorPane[Dynamic[angpt,
            {(angpt = {Cos[angctrl], Sin[angctrl]}) &,
              (ang =
                If[MemberQ[opts, gridsnap],
                  Round[Mod[ArcTan[#[[1]], #[[2]]], 2 Pi], Pi/12],
                  Mod[ArcTan[#[[1]], #[[2]]], 2 Pi]];
                angpt = Normalize[{Cos[ang], Sin[ang]}]) &,
              (angpt = Normalize[{Cos[ang], Sin[ang]}];
                angctrl =
                Mod[ArcTan[angpt[[1]], angpt[[2]]], 2 Pi]) &}],
            Dynamic[
            anglegraph[angpt,
              PlotLabel ->
              Column[{Style[Row[{"\[Theta] = ", Simplify[rnd@ang]}],
                  Red], Style[
                  Row[{Style["u", Bold], " = (",
                    Simplify[rnd@angpt[[1]]], ",",
                    Simplify[rnd@angpt[[2]]], ")"}], Red]}]]],
            Appearance -> None],
         
          Deploy@LocatorPane[Dynamic[thept,
            {thept = ptctrl,
              (thept =
                If[MemberQ[opts, gridsnap],
                  Round[#, {xgrid, ygrid}], #]) &,
              (thept =
                If[MemberQ[opts, gridsnap],
                  Round[#, {xgrid, ygrid}], #];
                ptctrl =
                If[MemberQ[opts, gridsnap],
                  Round[#, {xgrid, ygrid}], #]) &}],
           
            Dynamic[
            pointgraph[thept, angpt,
              PlotLabel ->
              Style[Row[{"point = (", rnd@thept[[1]], ",",
                  rnd@thept[[2]], ")"}], Red]]], Appearance -> None],
          "  ",
          Column[{
            Deploy@Dynamic[Text[Column[Style[#, 14] & /@ {
                 
                  Style[Row[{Style["\[Del]", Bold], TraditionalForm@f,
                    "(", rnd@thept[[1]], ",", rnd@thept[[2]], ") = ",
                    "(", (rnd[
                    D[ff[x, y], {{x, y}}] /. {x -> thept[[1]],
                    y -> thept[[2]]}])[[1]],
                    ", ", (rnd[
                    D[ff[x, y], {{x, y}}] /. {x -> thept[[1]],
                    y -> thept[[2]]}])[[2]], ")"}], Blue],
                 
                  Style[Row[{"||", Style["\[Del]", Bold],
                    TraditionalForm@f, "(", rnd@thept[[1]], ",",
                    rnd@thept[[2]], ")|| = ",
                    rnd[Norm[
                    D[ff[x, y], {{x, y}}] /. {x -> thept[[1]],
                    y -> thept[[2]]}]]}], Blue],
                  "",
                 
                  Style[Row[{Subscript["D", Style["u", Bold]],
                    TraditionalForm@f, "(", thept[[1]], ",",
                    thept[[2]], ") = ",
                    Simplify@
                    rnd[D[ff[x, y], {{x, y}}].angpt /. {x ->
                    thept[[1]], y -> thept[[2]]}]}],
                  Darker[Green, 0.5]]
                  }]]]
            }, ItemSize -> {"Columns" -> {15, 20, 5, 10}},
          Alignment -> Left]}}],
     
      SpanFromLeft},
     
      {Dynamic[surfacegraph[thept, angpt]],
     
      Deploy@Dynamic[contourgraph[thept, angpt]]}
      }, ItemSize -> {20}]
   
    }, Alignment -> {Center, Top}, ItemSize -> {"Rows" -> {20, 6}}]
 
  ] (*End Module*),

{{fcn, f1,
  Row[{TraditionalForm[f[x, y]], " = "}]}, {f1 ->
    TraditionalForm[4 - x^2 - y^2],
  f2 -> TraditionalForm[(y^2 - x^2)/2],
  f5 -> TraditionalForm[(x + y)/2],
  f3 -> TraditionalForm[x Cos[2 y]],
  f4 -> TraditionalForm[Sin[x] Cos[y]]}, ControlType -> PopupMenu},
{{opts, {showgrad, showunit}, ""}, {gridsnap -> "snap to grid     ",
  showgrad -> Row[{"show gradient \[Del]", TraditionalForm@f, " "}],
  showunit -> Row[{"show unit direction vector ", Style[u, Bold]}]},
  ControlType -> CheckboxBar, ControlPlacement -> Bottom},
{{ptctrl, {(xmin + xmax)/2, (ymin + ymax)/2}}, {xmin, ymin}, {xmax,
  ymax}, ControlType -> None},
{{angctrl, Pi/4}, 0, 2 Pi, ControlType -> None},

TrackedSymbols :> {fcn, ptctrl, angctrl, opts},
Initialization :> {
  xmin = -2; xmax = 2; ymin = -2; ymax = 2; zmin = 0; zmax = 4.1;
  {xgrid1, ygrid1} = {1/2, 1/2}
  }
]

=================================================================

Manipulate[
{{xmin, xmax}, {ymin, ymax}} = {{-2, 2}, {-2, 2}};
isize = Medium;
zmin = NMinimize[{f[x, y], {xmin <= x <= xmax,
      ymin <= y <= ymax}}, {x, y}][[1]];
zmax = NMaximize[{f[x, y], {xmin <= x <= xmax,
      ymin <= y <= ymax}}, {x, y}][[1]];
zlevel = -2(* zmin - 1.5 (zmax-zmin)*);
Show[
  Plot3D[f[x, y], {x, xmin, xmax}, {y, ymin, ymax},
  ImageSize -> isize, PlotStyle -> Opacity[.5],
  PlotRange -> {xmin, xmax}
  ],
  Graphics3D[{Red, Arrowheads[Large], PointSize[Large],
    Thickness[Large]
    , Point[{point[[1]], point[[2]], f[point[[1]], point[[2]]]}]
    , Arrow[{ per = 0;
      {point[[1]] - per D[f[x, y], x] /. {x -> point[[1]],
        y -> point[[2]]},
      point[[2]] -  per D[f[x, y], y] /. {x -> point[[1]],
        y -> point[[2]]},
      f[point[[1]], point[[2]]] + per},
      {point[[1]] + D[f[x, y], x] /. {x -> point[[1]],
        y -> point[[2]]},
      point[[2]] +  D[f[x, y], y] /. {x -> point[[1]],
        y -> point[[2]]},
      f[point[[1]], point[[2]]] - 1}
      }]
    }]
  ,
  Graphics3D[{
    Texture[
    ContourPlot[f[x, y], {x, xmin, xmax}, {y, ymin, ymax},
      Axes -> False, PlotRangePadding -> 0, Frame -> False,
      Epilog -> {Red, Arrowheads[Large], PointSize[Large],
        Thickness[Large], Point[{point[[1]], point[[2]]}]
        , Arrow[{{point[[1]], point[[2]]},
          {point[[1]] + D[f[x, y], x] /. {x -> point[[1]],
            y -> point[[2]]},
         
          point[[2]] +  D[f[x, y], y] /. {x -> point[[1]],
            y -> point[[2]]}}
          }]
        }
      ]]
    , EdgeForm[],
    Polygon[{{xmin, ymin, zlevel}, {xmax, ymin, zlevel}, {xmax, ymax,
      zlevel}, {xmin, ymax, zlevel}},
    VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},
  Lighting -> "Neutral"
 
  ]
  , PlotRange -> All, BoxRatios -> {1, 1, 1}, FaceGrids -> {Back, Left}
  ]
,
Row[{Style["f", Italic], "(", Style["x", Italic], ",",
  Style["y", Italic], ") ="}],
{{f, Function[{x1, y1}, 2 - (x1/2)^2 - (y1/2)^2], ""}, {
  Function[{x1, y1}, 2 - (x1/2)^2 - (y1/2)^2] ->
    TraditionalForm[2 - (x/2)^2 - (y/2)^2]
  , Function[{x1, y1}, 1.5 Sin[x1 y1]] -> TraditionalForm[Sin[x y]]
  , Function[{x1, y1}, 1/3 x1 E^(y1/4) + 1/2 Cos[x1 y1]] ->
    TraditionalForm[1/3 x E^(y/4) + 1/2 Cos[x y]]
  , Function[{x1, y1}, x1*Cos[y1]] -> TraditionalForm[x*Cos[y]]
  , Function[{x1, y1}, (x1^2 - y1^2)/2] ->
    TraditionalForm[(x^2 - y^2)/2]
  },
  PopupMenu},
Delimiter,
Row[{"(", Subscript[Style["x", Italic], 0], ", ",
  Subscript[Style["y", Italic], 0], ") = "}],
{{point, {Mean[{.5 xmin, xmax}], Mean[{.6 ymin, ymax}]}, ""},
  {xmin, ymin}, {xmax, ymax}, ControlType -> Slider2D},
TrackedSymbols :> {f, point},
AutorunSequencing -> {1, 2},
ControlPlacement -> Left
]

=============================================================

Manipulate[

{zmin, zmax} = Evaluate@Switch[f,
    Function[{x1, y1}, Sin[x1 - y1] + Cos[x1]], {-2, 2},
    Function[{x1, y1}, x1*Cos[y1]], {-3, 3},
    Function[{x1, y1}, (x1^2 - y1^2)/2], {-5, 5},
    Function[{x1, y1}, 4 - x1^2 - y1^2], {-14, 4}
    ];
plotrange = {{xmin, xmax}, {ymin, ymax}, {zmin, zmax}};
(*plotrange=AbsoluteOptions[Plot3D[f[x,y],{x,xmin,xmax},{y,ymin,ymax}\
],PlotRange];*)

Pane[
  Grid[{
    {
    If[setxy, pt = {x0, y0}, {x0, y0} = pt];
    {a, b} = {Cos[theta], Sin[theta]};
    slope = ({D[f[x, y], x], D[f[x, y], y]}.{a, b} /. {x ->
          a*t0 + x0, y -> b*t0 + y0});
    Grid[{{Text@
        Style[Row[{Style["f", Italic], "(", Style["x", Italic], ", ",
            Style["y", Italic], ") = ", TraditionalForm[f[x, y]]}],
          14]}}, ItemSize -> {Automatic, 2.2}, Alignment -> Top],
    SpanFromLeft},
    {
    Item[Show[
      If[showsurf,
        Plot3D[f[x, y], {x, xmin, xmax}, {y, ymin, ymax},
        Mesh -> False, PlotStyle -> {Gray, Opacity[surfopac]},
        BoundaryStyle -> None], {}],
     
      If[showplane,
        ParametricPlot3D[{a*t + x0, b*t + y0,
          f[a*t + x0, b*t + y0]}, {t, -10, 10},
        PlotStyle -> {Thick, Darker[Blue, 0.5]}], {}],
     
      If[showderiv, ParametricPlot3D[
        {a*t, b*t,
          slope*t} + {a*t0 + x0, b*t0 + y0, f[a*t0 + x0, b*t0 + y0]},
        {t, -1, 1}, PlotStyle -> {Blue, Thick}], {}],
     
      Graphics3D[{
        {Red, PointSize[0.02],
          Point[{0, 0, plotrange[[3, 1]]}]}, {Red,
          Line[{{0, 0, plotrange[[3, 1]]}, {a, b,
            plotrange[[3, 1]]}}]},
        {Black, PointSize[0.01], Point[{{x0, y0, f[x0, y0]}}]},
        If[
          showderiv, {Darker[Blue, 0.5], PointSize[0.03],
          Point[{{a*t0 + x0, b*t0 + y0,
              f[a*t0 + x0, b*t0 + y0]}}]}, {Black, PointSize[0.03],
          Point[{{x0, y0, f[x0, y0]}}]}],
        If[showplane, {Blue, Opacity[0.3],
         
          Polygon[{{-100 a + x0, -100 b + y0, -100}, {100 a + x0,
              100 b + y0, -100}, {100 a + x0, 100 b + y0,
              100}, {-100 a + x0, -100 b + y0, 100}}]}, {}]
        }],
     
      Boxed -> False, Axes -> True, AxesEdge -> Table[-1, {3}, {2}],
      BoxRatios -> Automatic, PlotRange -> plotrange,
      ImageSize -> {275, 275},
      AxesLabel ->
        Map[Style[#, 14] &, {Style["x", Italic], Style["y", Italic],
          Style["z", Italic]}]
      ], Alignment -> Top],
    "  ",
   
    Text@Item[Style[Column[{
          "",
          If[showderiv, Style[Column[{
             
              Row[{Subscript[Style["D", Italic], u],
                Style["f", Italic], "(", Style["x", Italic], ", ",
                Style["y", Italic], ") = \[Del]", Style["f", Italic],
                "(", Style["x", Italic], ", ", Style["y", Italic],
                ") ", Style["\[CenterDot]", Bold, 14],
                Style[" u", Italic]}],
             
              Row[{"\[Del]", Style["f", Italic], "(",
                Style["x", Italic], ", ", Style["y", Italic], ") = (",
                Subscript[Style["f", Italic], x], ", ",
                Subscript[Style["f", Italic], y], ")"}],
              "",
             
              Row[{Subscript[Style["f", Italic], x], "(",
                Style["x", Italic], ", ", Style["y", Italic], ") = ",
                TraditionalForm@D[f[x, y], x]}],
             
              Row[{Subscript[Style["f", Italic], x], "(",
                rndif[a*t0 + x0], ", ", rndif[b*t0 + y0], ") = ",
                D[f[x, y], x] /. {x -> x0, y -> y0}}],
              "",
             
              Row[{Subscript[Style["f", Italic], y], "(",
                Style["x", Italic], ", ", Style["y", Italic], ") = ",
                TraditionalForm@D[f[x, y], y]}],
             
              Row[{Subscript[Style["f", Italic], y], "(",
                rndif[a*t0 + x0], ", ", rndif[b*t0 + y0], ") = ",
                TraditionalForm@D[f[x, y], y] /. {x -> x0, y -> y0}}],
              "",
              Row[{"u = (", rndif[a], ", ", rndif[b], ")"}],
              "",
             
              Row[{Subscript["D", u], Style["f", Italic], "(",
                rndif[a*t0 + x0], ", ", rndif[b*t0 + y0], ") = ",
                TraditionalForm[slope]}]
              }], Blue], ""]
          }], 12], ItemSize -> 15.8, Alignment -> Left]
   
    }}, Alignment -> Top, ItemSize -> {Automatic, Automatic}],
  {500, 300}],

{{f, Function[{x1, y1}, Sin[x1 - y1] + Cos[x1]], "f(x,y) ="}, {
  Function[{x1, y1}, Sin[x1 - y1] + Cos[x1]] ->
    Row[{"sin(", Style["x", Italic], " - ", Style["y", Italic],
      ") + cos(", Style["x", Italic], ")"}],
  Function[{x1, y1}, x1*Cos[y1]] ->
    Row[{Style["x", Italic], " cos(", Style["y", Italic], ")"}],
  Function[{x1, y1}, (x1^2 - y1^2)/2] ->
    Row[{"(", Superscript[Style["x", Italic], 2], " - ",
      Superscript[Style["y", Italic], 2], ")/2"}],
  Function[{x1, y1}, 4 - x1^2 - y1^2] ->
    Row[{"4 - ", Superscript[Style["x", Italic], 2], " - ",
      Superscript[Style["y", Italic], 2]}]
  },
  PopupMenu}
,
{{surfopac, 0.5, "surface opacity"}, 0, 1},
Row[{
  PaneSelector[
    {True ->
      Column[{
        Row[{Subscript["x", 0], " ",
          Manipulator[Dynamic[x0], {-3, 3}, ImageSize -> Small,
          Appearance -> "Labeled"]}], "",
        Row[{Subscript["y", 0], " ",
          Manipulator[Dynamic[y0], {-3, 3}, ImageSize -> Small,
          Appearance -> "Labeled"]}]
        }],
    False ->
      Row[{"(", Subscript["x", 0], ", ", Subscript["y", 0], ") = ",
        Slider2D[Dynamic[pt], {{-3, -3}, {3, 3}}]}]},
    Dynamic@setxy
    ],
  "  ",
  Column[{Row[{"\[Theta] ",
      Manipulator[Dynamic[theta], {0, 2 Pi}, Appearance -> "Labeled",
        ImageSize -> Small]}],
    PaneSelector[{True ->
        Row[{"slide tangent ",
          Manipulator[Dynamic[t0, {(t0 = #) &, (t0 = 0) &}], {-3, 3},
          ImageSize -> Small]}], False -> ""},
      Dynamic@showderiv]}, Alignment -> Left]}],
{{pt, {Mean[{xmin, xmax}], Mean[{ymin, ymax}]},
  Row[{"(", Subscript["x", 0], ", ", Subscript["y", 0],
    ") = "}]}, {xmin, ymin}, {xmax, ymax}, None},

{{theta, Pi/4, "\[Theta]"}, 0, 2 Pi, None},
{{t0, 0, Subscript["t", 0]}, -3, 3, None},
{{showplane, True, "show plane"}, {True, False},
  ControlPlacement -> Left},
{{showderiv, False, "show tangent"}, {True, False},
  ControlPlacement -> Left},
Delimiter,
{{setxy, False,
  Row[{"set (", Subscript["x", 0], ", ", Subscript["y", 0],
    ")"}]}, {True, False}, ControlPlacement -> Left},
Delimiter,
{{showsurf, True, "show surface"}, {True, False},
  ControlPlacement -> Left},
{{x0, 0}, ControlType -> None},
{{y0, 0}, ControlType -> None},

Initialization :> (rndif[x_] :=
    If[Accuracy[x] == Infinity, x, Round[x, 0.001]];
  {{xmin, xmax}, {ymin, ymax}} = {{-3, 3}, {-3, 3}};),
AutorunSequencing -> {1, 2, 3, 4, 7}, TrackedSymbols -> Manipulate
]

Manipulate[

 DynamicModule[{grad, unitgrad, function, buttonText, functionButtons},

  function[x_, y_] := {5 - x^2/2 - y^2, x^2/2 + y^2, 1 - 2 x + y, 

    x^2/2 - y^2, -x^2/2 + y^2, Sin[Sin[y] + Sin[x]], 

    x y E^(-0.4 (x^2 + y^2))};

  buttonText = {" maximum", " minimum", " linear", " laddle 1", 

    " saddle 2", " example 1", " example 2"};

  functionButtons = 

   Map[#[[1]] -> #[[2]] &, 

    Transpose[{Range[Length[buttonText]], buttonText}]];

  grad = D[function[x, y][[fff]], {{x, y}}];

  unitgrad = grad/Sqrt[grad.grad]; 

  Deploy[

   Show[{

     ContourPlot[function[x, y][[fff]], {x, -3, 3}, {y, -3, 3}, 

      Contours -> 10],

     Graphics[{

       Red,

       If[MemberQ[options, gradient],

        If[

         MemberQ[options, normalize] && 

          Dynamic[grad /. {x -> pt[[1]], y -> pt[[2]]}] =!= {0, 0},

         Dynamic[

          Arrow[{pt, 

            pt + (unitgrad /. {x -> pt[[1]], y -> pt[[2]]})}]],

         Dynamic[Tooltip[

           Arrow[{pt, pt + (grad /. {x -> pt[[1]], y -> pt[[2]]})}], 

           Style[grad /. {x -> pt[[1]], y -> pt[[2]]}, Red]]],

         ],

        Red],

       If[

        MemberQ[options, normalize], {Black, Dynamic[Circle[pt, 1]]}, 

        Blue],

       Blue,

       If[MemberQ[options, neggradient],

        If[

         MemberQ[options, normalize] && 

          Dynamic[grad /. {x -> pt[[1]], y -> pt[[2]]}] =!= {0, 0}, 

         Dynamic[Arrow[{pt, 

            pt - (unitgrad /. {x -> pt[[1]], y -> pt[[2]]})}]],

         Dynamic[

          Tooltip[Arrow[{pt, 

             pt - (grad /. {x -> pt[[1]], y -> pt[[2]]})}], 

           Style[-grad /. {x -> pt[[1]], y -> pt[[2]]}, Blue]]]

         ],

        Blue],

       Tooltip[Locator[Dynamic[pt]], Dynamic[pt]]}]},

    ImageSize -> If[MemberQ[options, format], 500, 380],

    PlotLabel -> 

     If[MemberQ[options, label], 

      ToString[f[x, y], TraditionalForm] <> " = " <> 

       ToString[function[x, y][[fff]], TraditionalForm], 

      Column[{" "}, ItemSize -> {Automatic, 2.75}]]]]

  ],

 {{options, {gradient}, ""},

  {gradient -> Style[" \[Del]f", Red], 

   neggradient -> Style[" -\[Del]f", Blue], 

   normalize -> " normalizar          ", 

   format -> Style[" Formato amplio", 10],

   label -> Style[" Mostrar función", 10]}},

 {{fff, 1, "FUNCIÓN"}, functionButtons, ControlType -> Setter},

 {{pt, {1, 0}, "locación"}, {-3, -3}, {3, 3}, 

  ImageSize -> If[MemberQ[options, format], Medium, Tiny]},

 ControlType -> {CheckboxBar, Setter, Slider2D},

 ControlPlacement -> {Top, Top, Left},

 Initialization :> {Clear[x, y];

   buttonText = {" Máximo", " Mínimo", " lineal", " Silla 1", 

     " Silla 2", " Ejemplo 1", " Ejemplo 2"};

   functionButtons = 

    Map[#[[1]] -> #[[2]] &, 

     Transpose[{Range[Length[buttonText]], buttonText}]];}, 

 AutorunSequencing -> {1, 2, 3}]

==============================================================

Manipulate[
m = {{a1, b1}, {a2, b2}};
Show[VectorPlot[m.{x, y}, {x, -10, 10}, {y, -10, 10},
  StreamPoints -> {{pt1, pt2, pt3, pt4}},
  StreamStyle -> {Red, Thick}, ImageSize -> {460, 310}],
  Graphics[{Thick, Orange,
    Map[Line[{-100 #, 100 #}] &,
    Select[Eigenvectors[
      m], (Im[#[[1]]] == 0 && Im[#[[2]]] == 0) &]]}],
  PlotLabel ->
  Row[{Column[{Row[{Column[{Style[
            "\!\(\*OverscriptBox[\(x\), \(.\)]\)", Italic],
          Style["\!\(\*OverscriptBox[\(y\), \(.\)]\)", Italic]}],
        Column[{" = ", " = "}],
        TableForm[m.{Style["x", Italic], Style["y", Italic]}] //
          N}]}], "  ",
    Column[{"Eigenvalues:",
      NumberForm[Chop@N@Eigenvalues[m], {4, 2}]}], "  ", ,
    Column[{"Eigenvectors:",
      NumberForm[Chop@N@Eigenvectors[m][[1]], {4, 2}],
      NumberForm[Chop@N@Eigenvectors[m][[2]], {4, 2}] }]}]],
Style["\!\(\*OverscriptBox[\(\(x\)\(\\\ \)\), \(.\)]\)= \
\!\(\*SubscriptBox[\(a\), \(1\)]\)x + \!\(\*SubscriptBox[\(b\), \
\(1\)]\)y", Bold],
{{a1, 1, "\!\(\*SubscriptBox[\(a\), \(1\)]\)"}, -10, 10,
  Appearance -> "Labeled"},
{{b1, 1, "\!\(\*SubscriptBox[\(b\), \(1\)]\)"}, -10, 10,
  Appearance -> "Labeled"},
Style["\!\(\*OverscriptBox[\(y\), \(.\)]\) = \
\!\(\*SubscriptBox[\(a\), \(2\)]\)x + \!\(\*SubscriptBox[\(b\), \
\(2\)]\)y", Bold],
{{a2, 2, "\!\(\*SubscriptBox[\(a\), \(2\)]\)"}, -10, 10,
  Appearance -> "Labeled"}, {{b2, -2,
  "\!\(\*SubscriptBox[\(b\), \(2\)]\)"}, -10, 10,
  Appearance -> "Labeled"}, {{pt1, {-5.1, 4.8}}, {-10, -10}, {10, 10},
  Locator},
{{pt2, {4.9, 5.1}}, {-10, -10}, {10, 10}, Locator},
{{pt3, {-4.9, -5}}, {-10, -10}, {10, 10}, Locator},
{{pt4, {4.9, -5.2}}, {-10, -10}, {10, 10}, Locator},
TrackedSymbols -> True]