Chapter Three:

Surfaces

3.1 Using Two-Dimensional Tools

Clear[f]
f[x_, y_] := (x^2 + 3 y^2) Exp[1 - x^2 - y^2]

ContourPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}]

ContourPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5},
	AspectRatio->4/5, PlotPoints->40, ContourLevels->15]

ContourPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5},
   PlotRange->{.5, .5}, PlotPoints->40, ContourLevels->1]

DensityPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}, PlotPoints->25]

Plot[f[0, y], {y, -2.5, 2.5}]

3.2 Plotting Surfaces

Clear[f]
f[x_, y_] := (x^2 + 3 y^2) Exp[1 - x^2 - y^2]

Plot3D[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}]

Plot3D[f[x, y], {x, -2, 2}, {y, -2.5, 2.5},
	BoxRatios->{4, 5, 3}, PlotPoints->25,
	AxesEdge->{Automatic, {+1, -1}, Automatic},
	AxesLabel->{"x", "y", None}]

Show[%, ViewPoint->{1.6, 0, 0}, 
	AxesLabel->{None, "y", None},
	AxesEdge->{{-1, +1}, Automatic, Automatic},
	Ticks->{{0, -1, -2}, Automatic, Automatic}]

Show[%, ViewPoint->{1.6, 0, 0.3},
		AxesEdge->{None, {+1, -1}, None}]

Show[%, ViewPoint->{1.6, 0, 0.7}, 
		Boxed->False, Axes->None, AxesLabel->None]

Show[%, Lighting->True]

Show[%, AmbientLight->GrayLevel[0.15]]

Show[%1, Shading->False, Axes->Automatic, AxesEdge->Automatic,		
AxesLabel->{"x", "y", None}]

Show[%, Shading->True, LightSources->{},
		AmbientLight->GrayLevel[0.5]]

Show[%, AmbientLight->GrayLevel[0.3],
        LightSources->{
            {{-1, 0, 0}, RGBColor[1, 0, 0]}, 
            {{-1, 0, 0}, RGBColor[0, 1, 0]}, 
            {{-1, 0, 0}, RGBColor[0, 0, 1]}}]

Plot3D[{f[x, y], GrayLevel[1 + (x-2)/4]},
								{x, -2, 2}, {y, -2.5, 2.5}, 
	BoxRatios->{4, 5, 3}, Boxed-> False,
	PlotPoints->25,
	ViewPoint->{1.6, 0, 0.7},
	Axes->Automatic, AxesEdge->{None, {+1, -1}, None},
	AxesLabel->{None, "y", None}]

Plot3D[{f[x,y], GrayLevel[.1 + .9 (Abs[(x^2 - y^2)]/6.25)]},
								{x, -2, 2}, {y, -2.5, 2.5},
	Boxed->False, PlotPoints->25]

The following requires executing the implementation cells in the Animation file in Samples 3 folder; different than the Animation.m package!!!!

Options[SpinShow]

surface = Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2},
    PlotPoints->20, Shading->!False, Boxed->False,
    BoxRatios->{4, 5, 3}]

SpinShow[surface, SpinOrigin->{0, 0, .7}, 
SpinDistance->1, SpinTilt->{Pi/8, 0}, SpinSteps->20]

CriticalPoints[f_] := Block[{x, y},
	Solve[{D[f[x, y], x], D[f[x, y], y]} == {0, 0}, {x, y}]]
	
cps = CriticalPoints[f]

{D[f[x, y], x], D[f[x, y], y]} /. cps

SecondDerivTest[f_, {a_, b_}] := Block[{x, y, dxx, disc},
	dxx = N[D[f[x,y], x, x] /. {x -> a, y -> b}];
	disc = N[(dxx D[f[x, y], y, y] - D[f[x, y], x, y]^2) /.
								{x -> a, y -> b}];
	Return["Local maximum"] /; dxx < 0 && disc > 0;
	Return["Local minimum"] /; dxx > 0 && disc > 0;
	Return["Saddle point"]  /; disc < 0;
	Return["Test fails"]    /; disc == 0]

improved code for SecondDerivTest

SecondDerivTest[f_, {a_, b_}] := Block[{x, y, dxx, disc},
	dxx  = N[D[f[x,y], x, x] /. {x -> a, y -> b}];
	disc = N[(dxx D[f[x, y], y, y] - D[f[x, y], x, y]^2) /.
								{x -> a, y -> b}];
	
	Which[dxx < 0 && disc > 0, "Local maximum",
		  dxx > 0 && disc > 0, "Local minimum",
		  disc < 0, 		   "Saddle point",
		  disc == 0,		   "Test fails"]]

SecondDerivTest[f, {0, 0}]

Map[{SecondDerivTest[f, #], #, f@@#} &, {x,y} /. cps] //TableForm

3.3 Mixed Partial Derivatives Need Not Be Equal

f[x_, y_] := x y (x^2 - y^2) / (x^2 + y^2)
Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2},
	Boxed->False, Lighting->True, PlotPoints->31, Axes->None]

D[f[x, y], y, x] == D[f[x, y], x, y]

D[f[x, y], x] /. x -> 0

{D[D[f[x, y], x] /. x -> 0, y] /. y -> 0,
 D[D[f[x, y], y] /. y -> 0, x] /. x -> 0}

Simplify[D[(D[f[x,y], x] /. x -> a), y] /. y -> b]

g[a_, b_] := 
	((a - b)*(a + b)*(a^4 + 10*a^2*b^2 + b^4))/(a^2 + b^2)^3

DensityPlot[g[a, b], {a, -2, 2}, {b, -2, 2}, PlotPoints->40];

g[0, a]

g[a, a]

Simplify[g[a, m a]]

Plot[Table[Sin[x] + t Cos[x], {t, 0, 1, .1}], {x, 0, Pi}]

Plot[Release[Table[Sin[x] + t Cos[x], {t, 0, 1, .2}]],
											  {x, 0, Pi}]

FindMinimum[Simplify[g[a, m a]], {m, 1}]

3.4 Failure of the Only-Critical-Point-in-Town Test

f[x_, y_] := 3 Exp[y] x - x^3 - Exp[3 y]
D[f[x, y], x]

D[f[x, y], y]

Simplify[%/E^y]  (* Dividing by E^y eases the job of Solve *)

Solve[%%% == 0 && % == 0, {x, y}]

Clear[g]
g[x_, y_] := ArcTan[f[Tan[x], Tan[y]]]

Plot3D[g[x, y], {x, -1.57, 1.57}, {y, -1.57, 1.57}, 
		PlotPoints->40, ViewPoint->({.5, 1.5, .2}),
		Lighting->True, AmbientLight->GrayLevel[.1],
		Ticks->{Automatic, Automatic, {-1.5, 0, 1.5}},
		AxesEdge->{{1, -1}, {1, -1}, {-1, 1}},
		AxesLabel->{"x", "y", None},
		Boxed->False]

Show[%, ViewPoint->{2, .5, .3}, Ticks->Automatic,
		AmbientLight->GrayLevel[0],
		AxesEdge->{{1, -1}, {1, -1}, {1, -1}}];

g[x_, y_] := (s = Exp[-x]; s (x s + Cos[y]))

Plot3D[g[x, y], {x, -0.5, 1.7}, {y, -14.1, 14.1}, 
		ViewPoint->{2.4, -1.3, 1.4}, PlotPoints->40,
		AxesLabel->{"x", "y", None}, Boxed->False]

Plot[
       Release@Table[g[x, t], {t, 0, Pi, Pi/9}], {x, -.5, 1.7},
       Ticks->{{-.5}, {-3, -2}}, PlotRange->All,
       Epilog->{Text["y = Pi", {.5, 1}],
                Text["y = 0", {.5, -.65}]},
       PlotStyle->Thickness[.0005], AxesLabel->{"x", "z"}];