Mathematica Component of the Final Exam
Applied Calculus, Math 115
Due Saturday, December 13th at 5:00 pm

This component of the final is take-home.  Once you open this file, you may not communicate with anyone about it until you have handed it in.  You are expected to time yourself and take no more than two and a half hours to complete the following tasks.  Answer all questions and show all work in this notebook underneath the word "answer."  Once you are done, save this notebook with filename:
(your last name)_(your first initial)_AC_FINAL.nb
and submit it on WebCT in the assignment "Mathematica Final Exam."  You are welcome to e-mail your notebook to me or put it in my inbox on the fileserver as a backup.  Submissions after 9pm on Tuesday will not be accepted.
You are encouraged to use the stylesheet with this notebook.

Good luck, and have a good break.

<< 
      Graphics`Colors`
Off[
        General::"spell1"];
Off[
        General::"spell"];
MakeDataBarsOnly[dataTable_]:=Module[
{n, x = dataTable[[All, 1]], 
              y = dataTable[[All, 2]], maxY, minY, bars, edges, 
              prettyBars, points = dataTable}, 
n = 
              Length[x]; 
If[Max[y] > 0, maxY = Max[y], 
              maxY = 0]; 
If[Min[y] < 0, minY = Min[y], 
              minY = 0]; 
bars = 
              List[]; 
Do[
              bars = Append[bars, 
                  Graphics[{GrayLevel[0.9], 
                      Rectangle[{x[[j - 1]], 0}, {x[[j]], 
                          y[[j - 1]]}]}]], {j, 2, 
                n}]; 
edges = List[]; 
Do[
              edges = Append[edges, 
                  Graphics[{GrayLevel[0.7], 
                      Line[{{x[[j]], 0}, {x[[j]], 
                            y[[j]]}, {x[[j + 1]], 
                            y[[j]]}, {x[[j + 1]], 0}}]}]], {j, 1, 
                n - 1}]; 
prettyBars = 
              Join[bars, edges]; 
dots = 
              ListPlot[points, PlotStyle -> {PointSize[0.02]}, 
                DisplayFunction -> Identity]; 
Return[
              Show[{prettyBars, dots}, Axes -> True, 
                AxesOrigin -> {x[[1]], 0}, 
                DisplayFunction -> $DisplayFunction, 
                PlotRange -> {minY, maxY}]];
];
MakeDataBars[dataTable_, yhat_] := 
          Module[
{n, x = dataTable[[All, 1]], 
              y = dataTable[[All, 2]], bars, edges, prettyBars, 
              points = dataTable}, 
n = 
              Length[x]; 
bars = 
              List[]; 
Do[
              bars = Append[bars, 
                  Graphics[{GrayLevel[0.9], 
                      Rectangle[{x[[j - 1]], 0}, {x[[j]], 
                          y[[j - 1]]}]}]], {j, 2, 
                n}]; 
edges = List[]; 
Do[
              edges = Append[edges, 
                  Graphics[{GrayLevel[0.7], 
                      Line[{{x[[j]], 0}, {x[[j]], 
                            y[[j]]}, {x[[j + 1]], 
                            y[[j]]}, {x[[j + 1]], 0}}]}]], {j, 1, 
                n - 1}]; 
prettyBars = 
              Join[bars, edges]; 
dots = 
              ListPlot[points, PlotStyle -> {AbsolutePointSize[10]}, 
                DisplayFunction -> Identity]; 
curve = 
              Plot[yhat[t], {t, Min[x], Max[x]}, 
                DisplayFunction -> Identity]; 
Return[
              Show[{prettyBars, dots, curve}, Axes -> True, 
                AxesOrigin -> {x[[1]], 0}, 
                DisplayFunction -> $DisplayFunction]];
];
MakeRiemannBars[f_, xPartition_] := 
          Module[
{n, x = xPartition, y, minY, maxY, bars, 
              edges, prettyBars, points = dataTable}, 
y = 
              f[x]; 
If[Max[y] > 0, maxY = Max[y], 
              maxY = 0]; 
If[Min[y] < 0, minY = Min[y], 
              minY = 0]; 
n = 
              Length[x]; 
bars = 
              List[]; 
Do[
              bars = Append[bars, 
                  Graphics[{GrayLevel[0.9], 
                      Rectangle[{x[[j - 1]], 0}, {x[[j]], 
                          y[[j - 1]]}]}]], {j, 2, 
                n}]; 
edges = List[]; 
Do[
              edges = Append[edges, 
                  Graphics[{GrayLevel[0.7], 
                      Line[{{x[[j]], 0}, {x[[j]], 
                            y[[j]]}, {x[[j + 1]], 
                            y[[j]]}, {x[[j + 1]], 0}}]}]], {j, 1, 
                n - 1}]; 
prettyBars = 
              Join[bars, edges]; 
curve = 
              Plot[f[t], {t, Min[x], Max[x]}, 
                DisplayFunction -> Identity]; 
Return[
              Show[{prettyBars, curve}, Axes -> True, 
                AxesOrigin -> {x[[1]], 0}, 
                DisplayFunction -> $DisplayFunction, 
                PlotRange -> {minY, maxY}]];
];

Use Mathematica to find all solutions real solutions of the equation cos(3.2x) + x = 0.1x^2 - 1.7x - 1.  Plot both functions on a range so that all of these solutions can be seen.

Plot the functions y = cos(3.2x) + x and y = 0.1x^2 - 1.7x - 1 on the same set of axes.  Plot one of the functions in blue and the other in red.  Choose a range so that all of these solutions to the previous problem can be seen.

Suppose the velocity of a particle is given by 0.2t^2 + 7t + ln (t + 3) meters per second where t denotes the time in seconds.  Use a differential model to find the distance the particle moves in the first ten seconds.

Use Mathematica to find the derivative of the function f(x) = (x^(cos(x)).

Suppose a function of the form y = e^(A*x) is to be fit to the two data points (5, 19.2) and (12, 176.4). Define and plot the distance function using p = 4 and vertical residuals used to determine the value of A for the optimal model.  Choose a range so that the optimal value is visible.