(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "NeXT Mathematica Notebook Front End Version 2.2"; NeXTStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L3, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 14, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 12, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 10, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 14, "Times"; ; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 10, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nowordwrap, nohscroll, preserveAspect, M7, italic, B65535, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = leftheader, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, 12; fontset = leftfooter, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = completions, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = special1, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = special2, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, 12; fontset = special3, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, right, M7, 12; fontset = special4, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = special5, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; paletteColors = 128; currentKernel; ] :[font = title; inactive; preserveAspect] Chapter Three: Surfaces :[font = section; inactive; Cclosed; preserveAspect; startGroup] 3.1 Using Two-Dimensional Tools :[font = input; preserveAspect] Clear[f] f[x_, y_] := (x^2 + 3 y^2) Exp[1 - x^2 - y^2] :[font = input; preserveAspect] ContourPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}] :[font = input; preserveAspect] ContourPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}, AspectRatio->4/5, PlotPoints->40, ContourLevels->15] :[font = input; preserveAspect] ContourPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}, PlotRange->{.5, .5}, PlotPoints->40, ContourLevels->1] :[font = input; preserveAspect] DensityPlot[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}, PlotPoints->25] :[font = input; preserveAspect; endGroup] Plot[f[0, y], {y, -2.5, 2.5}] :[font = section; inactive; Cclosed; preserveAspect; startGroup] 3.2 Plotting Surfaces :[font = input; preserveAspect] Clear[f] f[x_, y_] := (x^2 + 3 y^2) Exp[1 - x^2 - y^2] :[font = input; preserveAspect] Plot3D[f[x, y], {x, -2, 2}, {y, -2.5, 2.5}] :[font = input; preserveAspect] 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}] :[font = input; preserveAspect] Show[%, ViewPoint->{1.6, 0, 0}, AxesLabel->{None, "y", None}, AxesEdge->{{-1, +1}, Automatic, Automatic}, Ticks->{{0, -1, -2}, Automatic, Automatic}] :[font = input; preserveAspect] Show[%, ViewPoint->{1.6, 0, 0.3}, AxesEdge->{None, {+1, -1}, None}] :[font = input; preserveAspect] Show[%, ViewPoint->{1.6, 0, 0.7}, Boxed->False, Axes->None, AxesLabel->None] :[font = input; preserveAspect] Show[%, Lighting->True] :[font = input; preserveAspect] Show[%, AmbientLight->GrayLevel[0.15]] :[font = input; preserveAspect] Show[%1, Shading->False, Axes->Automatic, AxesEdge->Automatic, AxesLabel->{"x", "y", None}] :[font = input; preserveAspect] Show[%, Shading->True, LightSources->{}, AmbientLight->GrayLevel[0.5]] :[font = input; preserveAspect] 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]}}] :[font = input; preserveAspect] 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}] :[font = input; Cclosed; preserveAspect; startGroup] 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] :[font = postscript; PICT; formatAsPICT; output; inactive; preserveAspect; pictureLeft = 2; pictureWidth = 330; pictureHeight = 330; endGroup; pictureID = 20733] :[font = text; inactive; preserveAspect] The following requires executing the implementation cells in the Animation file in Samples 3 folder; different than the Animation.m package!!!! ;[s] 5:0,0;65,1;74,2;83,3;92,4;144,-1; 5:1,13,10,Times,0,14,0,0,0;1,12,9,Times,1,14,0,0,0;1,13,10,Times,0,14,0,0,0;1,12,9,Times,1,14,0,0,0;1,13,10,Times,0,14,0,0,0; :[font = input; Cclosed; preserveAspect; startGroup] Options[SpinShow] :[font = output; output; inactive; preserveAspect; endGroup] {SpinOrigin -> {0, 0, 1.5}, SpinTilt -> {0, 0}, SpinDistance -> 2, SpinSteps -> 15, SpinRange -> {0, 360*Degree}, RotateLights -> False, Axes -> None} ;[o] {SpinOrigin -> {0, 0, 1.5}, SpinTilt -> {0, 0}, SpinDistance -> 2, SpinSteps -> 15, SpinRange -> {0, 360 Degree}, RotateLights -> False, Axes -> None} :[font = input; preserveAspect] surface = Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2}, PlotPoints->20, Shading->!False, Boxed->False, BoxRatios->{4, 5, 3}] :[font = input; preserveAspect] SpinShow[surface, SpinOrigin->{0, 0, .7}, SpinDistance->1, SpinTilt->{Pi/8, 0}, SpinSteps->20] :[font = input; Cclosed; preserveAspect; startGroup] CriticalPoints[f_] := Block[{x, y}, Solve[{D[f[x, y], x], D[f[x, y], y]} == {0, 0}, {x, y}]] cps = CriticalPoints[f] :[font = output; output; inactive; preserveAspect; endGroup] {{x -> 0, y -> 1}, {x -> 0, y -> -1}, {x -> 1, y -> 0}, {x -> -1, y -> 0}, {x -> 0, y -> 0}} ;[o] {{x -> 0, y -> 1}, {x -> 0, y -> -1}, {x -> 1, y -> 0}, {x -> -1, y -> 0}, {x -> 0, y -> 0}} :[font = input; Cclosed; preserveAspect; startGroup] {D[f[x, y], x], D[f[x, y], y]} /. cps :[font = output; output; inactive; preserveAspect; endGroup] {{0, 0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}} ;[o] {{0, 0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}} :[font = input; preserveAspect] 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] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] improved code for SecondDerivTest ;[s] 2:0,0;18,1;34,-1; 2:1,10,8,Times,1,12,0,0,0;1,10,8,Courier,1,12,0,0,0; :[font = input; preserveAspect; endGroup] 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"]] :[font = input; Cclosed; preserveAspect; startGroup] SecondDerivTest[f, {0, 0}] :[font = output; output; inactive; preserveAspect; endGroup] "Local minimum" ;[o] Local minimum :[font = input; Cclosed; preserveAspect; startGroup] Map[{SecondDerivTest[f, #], #, f@@#} &, {x,y} /. cps] //TableForm :[font = output; output; inactive; preserveAspect; endGroup; endGroup] TableForm[{{"Local maximum", {0, 1}, 3}, {"Local maximum", {0, -1}, 3}, {"Saddle point", {1, 0}, 1}, {"Saddle point", {-1, 0}, 1}, {"Local minimum", {0, 0}, 0}}] ;[o] Local maximum {0, 1} 3 Local maximum {0, -1} 3 Saddle point {1, 0} 1 Saddle point {-1, 0} 1 Local minimum {0, 0} 0 :[font = section; inactive; Cclosed; preserveAspect; startGroup] 3.3 Mixed Partial Derivatives Need Not Be Equal :[font = input; preserveAspect] 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] :[font = input; Cclosed; preserveAspect; startGroup] D[f[x, y], y, x] == D[f[x, y], x, y] :[font = output; output; inactive; preserveAspect; endGroup] True ;[o] True :[font = input; Cclosed; preserveAspect; startGroup] D[f[x, y], x] /. x -> 0 :[font = output; output; inactive; preserveAspect; endGroup] -y ;[o] -y :[font = input; Cclosed; preserveAspect; startGroup] {D[D[f[x, y], x] /. x -> 0, y] /. y -> 0, D[D[f[x, y], y] /. y -> 0, x] /. x -> 0} :[font = output; output; inactive; preserveAspect; endGroup] {-1, 1} ;[o] {-1, 1} :[font = input; Cclosed; preserveAspect; startGroup] Simplify[D[(D[f[x,y], x] /. x -> a), y] /. y -> b] :[font = output; output; inactive; preserveAspect; endGroup] ((a - b)*(a + b)*(a^4 + 10*a^2*b^2 + b^4))/(a^2 + b^2)^3 ;[o] 4 2 2 4 (a - b) (a + b) (a + 10 a b + b ) ------------------------------------ 2 2 3 (a + b ) :[font = input; preserveAspect] g[a_, b_] := ((a - b)*(a + b)*(a^4 + 10*a^2*b^2 + b^4))/(a^2 + b^2)^3 :[font = input; preserveAspect] DensityPlot[g[a, b], {a, -2, 2}, {b, -2, 2}, PlotPoints->40]; :[font = input; Cclosed; preserveAspect; startGroup] g[0, a] :[font = output; output; inactive; preserveAspect; endGroup] -1 ;[o] -1 :[font = input; Cclosed; preserveAspect; startGroup] g[a, a] :[font = output; output; inactive; preserveAspect; endGroup] 0 ;[o] 0 :[font = input; Cclosed; preserveAspect; startGroup] Simplify[g[a, m a]] :[font = output; output; inactive; preserveAspect; endGroup] -(((-1 + m)*(1 + m)*(1 + 10*m^2 + m^4))/(1 + m^2)^3) ;[o] 2 4 (-1 + m) (1 + m) (1 + 10 m + m ) -(---------------------------------) 2 3 (1 + m ) :[font = input; Cclosed; preserveAspect; startGroup] Plot[Table[Sin[x] + t Cos[x], {t, 0, 1, .1}], {x, 0, Pi}] :[font = message; inactive; preserveAspect] Plot::notnum: Table[Sin[x] + t Cos[x], {t, 0, 1, 0.1}] does not evaluate to a real number at x=0.. :[font = message; inactive; preserveAspect] Plot::notnum: Table[Sin[x] + t Cos[x], {t, 0, 1, 0.1}] does not evaluate to a real number at x=0.1309. :[font = message; inactive; preserveAspect] Plot::notnum: Table[Sin[x] + t Cos[x], {t, 0, 1, 0.1}] does not evaluate to a real number at x=0.261799. :[font = message; inactive; preserveAspect; endGroup] General::stop: Further output of Plot::notnum will be suppressed during this calculation. :[font = input; preserveAspect] Plot[Release[Table[Sin[x] + t Cos[x], {t, 0, 1, .2}]], {x, 0, Pi}] :[font = input; Cclosed; preserveAspect; startGroup] FindMinimum[Simplify[g[a, m a]], {m, 1}] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {-1.41421356237168133, {m -> 2.414210775170481322}} ;[o] {-1.41421, {m -> 2.414210775170481322}} :[font = section; inactive; Cclosed; preserveAspect; startGroup] 3.4 Failure of the Only-Critical-Point-in-Town Test :[font = input; Cclosed; preserveAspect; startGroup] f[x_, y_] := 3 Exp[y] x - x^3 - Exp[3 y] D[f[x, y], x] :[font = output; output; inactive; preserveAspect; endGroup] 3*E^y - 3*x^2 ;[o] y 2 3 E - 3 x :[font = input; Cclosed; preserveAspect; startGroup] D[f[x, y], y] :[font = output; output; inactive; preserveAspect; endGroup] -3*E^(3*y) + 3*E^y*x ;[o] 3 y y -3 E + 3 E x :[font = input; Cclosed; preserveAspect; startGroup] Simplify[%/E^y] (* Dividing by E^y eases the job of Solve *) :[font = output; output; inactive; preserveAspect; endGroup] -3*E^(2*y) + 3*x ;[o] 2 y -3 E + 3 x :[font = input; Cclosed; preserveAspect; startGroup] Solve[%%% == 0 && % == 0, {x, y}] :[font = message; inactive; preserveAspect] Solve::ifun: Warning: inverse functions are being used by Solve, so some solutions may not be found. :[font = output; output; inactive; preserveAspect; endGroup] {{y -> 0, x -> 1}, {y -> Log[E^((2*I)/3*Pi)], x -> E^((4*I)/3*Pi)}, {y -> Log[E^((4*I)/3*Pi)], x -> E^((8*I)/3*Pi)}, {y -> DirectedInfinity[-1], x -> 0}} ;[o] (2 I)/3 Pi (4 I)/3 Pi {{y -> 0, x -> 1}, {y -> Log[E ], x -> E }, (4 I)/3 Pi (8 I)/3 Pi {y -> Log[E ], x -> E }, {y -> -Infinity, x -> 0}} :[font = input; preserveAspect] Clear[g] g[x_, y_] := ArcTan[f[Tan[x], Tan[y]]] :[font = input; preserveAspect] 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] :[font = input; preserveAspect] Show[%, ViewPoint->{2, .5, .3}, Ticks->Automatic, AmbientLight->GrayLevel[0], AxesEdge->{{1, -1}, {1, -1}, {1, -1}}]; :[font = input; preserveAspect] g[x_, y_] := (s = Exp[-x]; s (x s + Cos[y])) :[font = input; preserveAspect] 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] :[font = input; preserveAspect; endGroup] 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"}]; ^*)