Mathematica Worksheet

Problem 1

First define the function.

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

Then, generate the 3D plot.

plot1  =  
      Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2}, PlotPoints -> 25, 
        PlotRange -> {-1, 1}]

Now, view the plot from many angles. From these we see that we have an absolute max at one point and an absolute min at one point.

Show[plot1, ViewPoint -> {2, 2, 0}, 
      AxesLabel -> {"x", "y", "z"}]

Show[plot1, ViewPoint -> {-2, 2, 0}, 
      AxesLabel -> {"x", "y", "z"}]

Show[plot1, ViewPoint -> {2, -2, 1}, 
      AxesLabel -> {"x", "y", "z"}]

Solve the equations to find the values. The symbolic solver produces something which is hard to interpret.

eq1  =  D[f[x, y], x] == 0
eq2  =  D[f[x, y], y] == 0
Solve[{eq1, eq2}, {x, y}]

Load the NonReal package.

<< Miscellaneous`RealOnly`

Solve the system of equations numerically.

eq1  =  D[f[x, y], x] == 0
eq2  =  D[f[x, y], y] == 0
NSolve[{eq1, eq2}, {x, y}]

Show[plot1, AxesLabel -> {"x", "y", "z"}]

Generate the contour plot of the surface.

ContourPlot[f[x, y], {x, -2, 2}, {y, -2, 2}, 
      Contours -> 20, PlotPoints -> 100]

If we evaluate the function at the points we can determine the absolute max and absolute min.

f[-1.022, -0.5026]
f[-0.4349, 1.003]
f[0. , 0. ]
f[0.4663, 0.56098]
f[1.0936, -0.3761]
f[1.1037, 1.5353]

To see numerically that the last point in a saddle point, we add a small amount to each variable in turn, and note that by moving away from the saddle point in y decreases the value of the function, yet moving away from the point in x increases the value of the function.

f[1.1037, 1.5353]
f[1.1037, 1.5353 + 0.01]
f[1.1037 + 0.01, 1.5353]

Problem 2

Table[
      Show[plot1, ViewPoint -> {5  Abs[n], 5  Abs[n], 3}, 
        Axes -> False, ColorFunction -> Hue, Mesh -> True, 
        Boxed -> False], {n, -5, 5, 0.302}]

num  =  30
Table[
      Show[plot1, ViewPoint -> {5  Cos[n], 5  Sin[n], 0}, 
        Axes -> False, ColorFunction -> Hue, Mesh -> True, 
        Boxed -> False, AspectRatio -> 1], {n, 0, 
        2  Pi - 2  Pi/num, 2  Pi/num}]

You can load an animation package which does some nice animation things for you:

<< Graphics`Animation`

SpinShow[plot1, Frames -> 10, 
      SpinRange -> {0 Degree, 180 Degree}]

Problem 3

Clear[y, x, k]
deq  =  y'[x]  ==  
        x^2 y[x]  +   y[x]^2
DSolve[deq, y[x], x]
DSolve[{deq, y[0] == k}, y[x], x]
sol[x_, k_]  =  Part[%, 1, 1, 2]

These solutions are complex valued.

Re[sol[0.75, -1]]
Im[sol[0.75, -1]]

Here is a plot of the real part.

Table[Plot[Re[sol[x, n]], {x,  0, 2}], {n, -1, 1}]

Simplify[sol[x, -1]]
Simplify[sol[x, 0]]
Simplify[sol[x, 1]]