(***********************************************************************

                    Mathematica-Compatible Notebook

This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the notebook 
starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do one of 
the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the 
word CacheID, otherwise Mathematica-compatible applications may try to 
use invalid cache data.

For more information on notebooks and Mathematica-compatible 
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info@wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from 
Wolfram Research.
***********************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[     45678,       1353]*)
(*NotebookOutlinePosition[     48043,       1444]*)
(*  CellTagsIndexPosition[     47668,       1425]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Modeling a Bungee Cord Jump: A Classroom Experiment ", "Title",
  PageWidth->PaperWidth],

Cell[TextData[StyleBox["Chapter 5, Section 4 (Section 5 in the Early \
Transcendentals)",
  FontFamily->"Arial",
  FontSize->16,
  FontWeight->"Bold"]], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(Off[General::"\<spell1\>"];\)\)], "Input",
  PageWidth->PaperWidth,
  CellOpen->False,
  InitializationCell->True],

Cell[CellGroupData[{

Cell["Introduction: The Challenge", "Section",
  PageWidth->PaperWidth],

Cell["\<\
OBJECTIVE: Collect data for a bungee cord (or use data collected by Carroll \
College students); build, test, and refine a model for a bungee jumper; and \
estimate the length of bungee cord necessary to achieve a desired length of \
fall.

In a recent television commercial, a bungee jumper comes so close to the \
ground that he is able to dip a corn chip he holds in his mouth into a bowl \
of salsa on the ground without bumping his nose. To do such a jump \
successfully, the bungee jumper would have to do some serious mathematical \
modeling, which we proposed to do with students at Carroll College. So, to \
present the students with \"The Bungee Cord Challenge\", we acquired some \
bungee cord material (approximately one-eighth inch in diameter), cut it into \
various lengths, and gave a piece to each group of students. We also gave \
them a set of 0.2 kg masses and a metric tape measure. We now present to you \
the challenge as it was made to students at Carroll College: given a fall \
distance, how long should you cut the bungee cord so that a 0.2 kg mass, when \
dropped from that height, would just \"kiss\" the floor?
\
\>", "Text",
  PageWidth->PaperWidth],

Cell[CellGroupData[{

Cell["Technology Guidelines", "Subsection",
  PageWidth->PaperWidth,
  CellDingbat->"\[LightBulb]"],

Cell[TextData[{
  StyleBox["NOTE:  If you have just finished a module, restart ",
    CellFrame->True,
    Background->None],
  StyleBox["Mathematica",
    CellFrame->True,
    FontSlant->"Italic",
    Background->None],
  StyleBox[" before executing a new module.\nTO OPEN CELLS, put your cursor \
on the right cell bracket and double click.",
    CellFrame->True,
    Background->None],
  "\nINITIALIZATION CELLS\n\tWhen asked if you want to \". . . automatically \
evaluate all the initialization cells in the \tnotebook . . . ,\" respond by \
pressing the \"Yes\" button.\nTO STOP AN EXECUTION\n\tSelect the ",
  StyleBox["Kernel",
    FontSlant->"Italic"],
  " pull-down menu and click on ",
  StyleBox["Abort Evaluation.\n",
    FontSlant->"Italic"],
  "ORDER OF EXECUTION\n\tExecute cells in the order given. Do not skip any \
Input cells within a given notebook.\nSAVING NOTEBOOKS\n\tYou can save \
anytime to any directory you choose, and it is wise to save often.\n\t \
However, before you do your final save, delete all your output by selecting \
the \n\t ",
  StyleBox["Delete All Output",
    FontSlant->"Italic"],
  " selection under the ",
  StyleBox["Kernel",
    FontSlant->"Italic"],
  " pull-down menu.\nEXPERIENCING MAJOR PROBLEMS\n\tSave if appropriate, and \
then shut down ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " and start it up again."
}], "Text",
  PageWidth->PaperWidth]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{

Cell["Part I: The Experiment", "Section",
  PageWidth->PaperWidth],

Cell[TextData[{
  "An important element in a complicated model like bungee cord jumping is \
the spring-like behavior of the bungee cord. In order to characterize this \
behavior, we asked our students to measure the unstretched length of their \
piece of cord and then hang 0.2 kg increments of mass from the cord and \
measure its stretch in meters for each value of hanging mass. So that we \
could introduce the length of the bungee cord as a variable parameter in the \
model, the students then calculated the relative stretches for each mass \
increment, that is, the stretch divided by the unstretched length of the \
cord. This gives the stretch per unit length of cord for a given mass. \
Engineers call this relative stretch the strain, and it has units of \
meters/meter or inches/inch. (Can you see why engineers might want to measure \
strain instead of stretch? Think about the vertical hanging cables that \
support the Golden Gate Bridge deck.) We also converted the mass quantities \
to forces in newtons, multiplying each mass value by 9.8 m/",
  Cell[BoxData[
      \(TraditionalForm\`s\^2\)]],
  ". Since we \"normalized\" the measure of the stretch by calculating the \
relative stretches (i.e., the strain), all of the groups got similar results. \
\n\nThe following data set (borrowed from a group of students at Carroll \
College in Montana) is a list of ordered pairs, in which the first value in \
each ordered pair is the strain or relative stretch of the bungee cord in \
meters/meter, and the second value is the corresponding force in newtons.\n"
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(data = {{0, 0}, {0.0142, 1.96}, {0.0857, 3.92}, {0.2662, 
            5.87}, {0.4948, 7.85}};\)\), "\n", 
    \(TableForm[data, 
      TableHeadings \[Rule] {None, {"\<strain(meters/meter)\>", \
"\<force(N)\>"}}]\)}], "Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h1",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h1b"],

Cell[BoxData[
    \(\(p1 = 
        ListPlot[data, 
          PlotStyle -> {PointSize[0.04], RGBColor[0.996109, \ 0, \ 0]}, 
          AxesLabel \[Rule] {"\<strain(m/m)\>", "\<force(N)\>"}];\)\)], \
"Input",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell["Part II: Designing a Model", "Section",
  PageWidth->PaperWidth],

Cell[TextData[{
  "There appears to be a trend that we can capture with a mathematical model, \
and now we try to find a suitable one using the ",
  StyleBox["Fit[ ]",
    FontWeight->"Bold"],
  " function. What does the function look like to you? Does it look like a \
radical or log function? We will try a power function with several different \
rational exponents, letting ",
  StyleBox["x ",
    FontWeight->"Bold"],
  "represent the strain and ",
  StyleBox["y[x_]",
    FontWeight->"Bold"],
  " the force corresponding to a strain of ",
  StyleBox["x",
    FontWeight->"Bold"],
  "."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(n = 0.15;\)\), "\n", 
    \(\(Clear[y];\)\), "\n", 
    \(y[x_] = Fit[data, {x^n}, x]\)}], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "Next, we plot our model function, save it as ",
  StyleBox["p2",
    FontWeight->"Bold"],
  ",",
  " and then show the plots of the data and the model function together on \
the same graph."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(p2 = 
        Plot[y[x], {x, 0, 0.6}, 
          PlotStyle -> {RGBColor[0, 0, 1], Thickness[0.015]}, 
          AxesLabel \[Rule] {"\<strain(m/m)\>", "\<force(N)\>"}];\)\)], \
"Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(\(\(Show[p2, p1];\)\(\[IndentingNewLine]\)\)\( (*\ 
      Putting\ p2\ first\ puts\ the\ data\ points\ on\ top\ of\ the\ model\ \
graph\ instead\ of\ under\ \(\(it\)\(.\)\)*) \)\)\)], "Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h2",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h2b"]
}, Closed]],

Cell[CellGroupData[{

Cell["Part III: Assessing the Errors", "Section",
  PageWidth->PaperWidth],

Cell["\<\
Note: This Part duplicates the discussion of residual errors and the \"rms\" \
measure of the error in Part III of the module entitled, \"Modeling Change: \
Springs, Driving Safety, Radioactivity, Trees, Fish, and Mammals.\" If you \
are already familiar with the concepts of residual error and \"rms\" measure \
of the error, skip directly to \"You Try It: Improving the Model.\"

Our model doesn't appear to be very good! Let's quantify just how good (or \
bad) it is. You guessed right; we should calculate the residual errors.\
\>", "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(residuals = 
        Table[{data[\([i, 1]\)], data[\([i, 2]\)] - y[data[\([i, 1]\)]]}, {i, 
            1, Length[data]}];\)\), "\[IndentingNewLine]", 
    \(TableForm[residuals, 
      TableHeadings \[Rule] {None, {"\<Strain (meters/meter)\>", "\<Residual \
Error (N)\>"}}]\)}], "Input",
  PageWidth->PaperWidth],

Cell["\<\
We plot the residuals to see if the errors appear to be random or if there is \
a discernable pattern.\
\>", "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(ListPlot[residuals, 
        PlotStyle \[Rule] {RGBColor[1, 0, 0], PointSize[0.022]}, 
        AxesLabel \[Rule] {"\<Strain(m/m)\>", "\<Residual(N)\>"}];\)\)], \
"Input",
  PageWidth->PaperWidth],

Cell["\<\
The plot suggests that there is a pattern to the errors and that the model \
needs improvement.

To get a global measure of the error for all of the data points in the set, \
you might be inclined to calculate the average (mean) all of the individual \
or local residuals, but this can be very misleading. \
\>", "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(residavg = 
      Sum[residuals[\([i, 2]\)], {i, 1, Length[data]}]/
        Length[data]\)], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "As you can see, the mean residual error is small relative to the average \
size of the forces in the data set. On this basis, we might be led to believe \
that our model isn't so bad after all. Wrong! The problem is that the \
individual or local errors are actually sizable when compared to the measured \
forces, but because some of them are positive and some are negative, they \
tend to cancel each other when we add them together to calculate their mean \
value. Look at the values in the list of residual errors, or look at the \
vertical differences between the data points and the fit function on the \
graph, and you can easily see that the average of the residual errors is \
misleading.\n\nThere is an infinite number of ways to address this canceling \
problem, but one of the most common is to calculate the sum of the squares of \
the residuals and try to find the smallest or least value of this sum of the \
squares of residuals. Hence, we have the term \"least squares,\" which you \
may have heard before. Squaring the residuals removes the canceling effect \
that occurs when we add them together for a measure of the global error. The \
",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " ",
  StyleBox["Fit[ ]",
    FontWeight->"Bold"],
  " function uses least squares, and some variations of it, to find a \
best-fit function for a set of data. Finding the minimum value for the sum of \
squared residuals is a problem that can be solved using calculus, and you \
will study this problem later on, but for now you can do it by trial and \
error. Let's get back to our bungee cord challenge. What we want to do now is \
calculate the sum of the squares of the residuals for our data set. "
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(residsquaresum = 
      Sum[residuals[\([i, 2]\)]^2, {i, 1, Length[data]}]\)], "Input",
  PageWidth->PaperWidth],

Cell["\<\
Before we compare this value, we calculate the mean of the squared residuals.\
\
\>", "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(msresiduals = residsquaresum/Length[data]\)], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "Comparing the average of the squared residuals with the average of the \
force values in the data set would be like comparing apples with oranges \
because ",
  StyleBox["msresiduals",
    FontWeight->"Bold"],
  " is an average of squares, whereas the force average is not. To make a \
fair comparison, we take the square root of the mean of the squares."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(rmsresiduals = Sqrt[msresiduals]\)], "Input",
  PageWidth->PaperWidth],

Cell["\<\
The value that we calculate in the preceding step is the root of the mean of \
the squares of the residuals, oftentimes called the root-mean-square or \"rms\
\" value of the residuals. 
\
\>", "Text",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell["You Try It: Improving the Model", "Section",
  PageWidth->PaperWidth],

Cell[TextData[{
  "Now we have a fair number to compare with the average of the measured \
force values. As we initially expected, this comparison demonstrates that our \
model needs improvement. We will leave that up to you, but, to help out, we \
group all of the commands that you need for the error analysis into the cell \
that follows. Use trial and error to find a better model function by changing \
the value of the exponent ",
  StyleBox["n",
    FontSlant->"Italic"],
  " (highlighted in red) to minimize the sum of the squared residuals, which \
will also minimize the rms measure of the error. \n\n(Before you proceed, we \
offer some comments about errors in modeling: in mathematical modeling, you \
cannot completely eliminate errors. Random errors occur in measurements due \
to the limited precision of all measuring instruments, and systematic errors, \
that is, errors that follow a pattern, occur due to shortcomings of the model \
and/or possible defects in the measuring tools. Systematic errors can often \
be reduced or eliminated by refining the model and by repairing and/or \
calibrating the measuring equipment, but random errors are unavoidable. We \
can reduce the magnitudes of random errors by using more precise instruments, \
but we cannot eliminate them; the errors may be smaller, but they are always \
present. With this in mind, select a value for ",
  StyleBox["n",
    FontSlant->"Italic"],
  " that minimizes ",
  StyleBox["residsquaresum",
    FontWeight->"Bold"],
  ", the sum of the squares of the residuals.)"
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h3",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h3b"],

Cell[BoxData[{
    RowBox[{
      RowBox[{"n", "=", 
        StyleBox["0.15",
          FontColor->RGBColor[1, 0, 0]]}], 
      ";"}], "\n", \(Clear[y];\), "\n", \(y[x_] = 
        Fit[data, {x^n}, 
          x];\), "\[IndentingNewLine]", \(Print["\<The model is \>", 
        y[x]];\), "\n", \(p2 = 
        Plot[y[x], {x, 0, 0.6}, 
          PlotStyle -> {RGBColor[0, 0, 1], Thickness[0.015]}, 
          AxesLabel \[Rule] {"\<strain(m/m)\>", "\<force(N)\>"}, 
          DisplayFunction \[Rule] Identity];\), "\n", \(Show[p2, p1, 
        DisplayFunction \[Rule] $DisplayFunction];\), "\n", \(residuals = 
        Table[{data[\([i, 1]\)], data[\([i, 2]\)] - y[data[\([i, 1]\)]]}, {i, 
            1, Length[data]}];\), "\n", \(residsquaresum = 
        Sum[residuals[\([i, 2]\)]^2, {i, 1, 
            Length[data]}];\), "\[IndentingNewLine]", 
    RowBox[{\(Print["\<The sum of the squares of the residuals is \>", 
          residsquaresum];\), "\n"}]}], "Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h4",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h4b"]
}, Closed]],

Cell[CellGroupData[{

Cell["Part IV: You Can't Push a Rope", "Section",
  PageWidth->PaperWidth],

Cell[TextData[{
  "We need to address one final item before we take the bungee cord \
challenge. You may have heard the expression, \"You can't push a rope.\" In \
the context of our bungee cord, this means that if the stretch is negative \
(i.e., if we try to push on the ends of the bungee) the bungee simply folds, \
and the force in it is 0. To accommodate this, we modify our model to say \
that if the stretch is negative, the force is zero. Here's how we do it in ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  "."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(Clear[bungeeforce];\)\), "\n", 
    \(\(bungeeforce[x_] = 
        Which[x < 0, 0, x \[GreaterEqual] 0, y[x]];\)\)}], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "Observe the graph of the force in the bungee cord for negative as well as \
positive values of ",
  StyleBox["x",
    FontSlant->"Italic"],
  ", the strain in the bungee cord."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(Plot[bungeeforce[x], {x, \ \(-0.6\), 0.6}, 
        PlotStyle -> {RGBColor[0, 0, 1], Thickness[0.015]}, 
        AxesLabel \[Rule] {"\<strain(m/m)\>", "\<force(N)\>"}];\)\)], "Input",\

  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h5",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h5b"],

Cell["\<\
This model provides a nice, real-world example of a piecewise-defined \
function. The extended piecewise-defined model is useful for solving the \
differential equation of motion to obtain a more detailed description of the \
motion of the bungee jumper during the fall. \
\>", "Text",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell["Part V: Using the Model", "Section",
  PageWidth->PaperWidth],

Cell["\<\
Chapter 5, Section 4 (Section 5 in Early Transcendentals), Exercise 25\
\>", "Text",
  PageWidth->PaperWidth,
  FontWeight->"Bold"],

Cell[TextData[{
  "We're ready to tackle the bungee cord challenge. We will use the \
Work-Energy Theorem, a principle from physics, to calculate the fall distance \
for a given length of bungee cord. The Work-Energy Theorem states that when \
an object (in this case the 0.2 kg mass) moves through a distance (the fall), \
the total work done on the object during the motion is equal to the \
difference in the kinetic energy of the mass between the beginning and end of \
the fall. If ",
  Cell[BoxData[
      \(TraditionalForm\`W\_total\)]],
  " is the total work done and ",
  StyleBox["K",
    FontSlant->"Italic"],
  " is the kinetic energy, then the Work-Energy Theorem says that from the \
beginning to the end of the fall, ",
  Cell[BoxData[
      \(TraditionalForm\`\(\(W\_total\)\(\ \)\)\)]],
  Cell[BoxData[
      \(TraditionalForm\` = \)]],
  " \[CapitalDelta]",
  StyleBox["K",
    FontSlant->"Italic"],
  ". Exercise 25 in Section 4 of Chapter 5 (in Section 5 of Chapter 5 in \
Early Transcendentals) asks you to derive this result using Newton's Second \
Law of Motion and the Chain Rule.\n\nThe kinetic energy of a mass is the \
energy that it has by virtue of its motion, and it is calculated by ",
  StyleBox["K ",
    FontSlant->"Italic"],
  Cell[BoxData[
      \(TraditionalForm\` = \)]],
  Cell[BoxData[
      \(TraditionalForm\`\(\(\ \)\(1\/2\)\)\)]],
  StyleBox["m",
    FontSlant->"Italic"],
  Cell[BoxData[
      \(TraditionalForm\`v\^2\)]],
  ", where ",
  StyleBox["m",
    FontSlant->"Italic"],
  " is the mass of the object and ",
  StyleBox["v",
    FontSlant->"Italic"],
  " is its speed. In our problem, the mass is dropped from rest and, at the \
bottom of the fall, it comes to rest again but just for an instant before the \
stretched bungee begins to pull it back up. Therefore, ",
  Cell[BoxData[
      \(TraditionalForm\`v = 0\)]],
  " at the beginning and at the end of the fall, so the change in kinetic \
energy is 0, that is, ",
  Cell[BoxData[
      FormBox[
        RowBox[{
          StyleBox[
            RowBox[{"\[CapitalDelta]", 
              StyleBox["K",
                FontSlant->"Italic"]}]], "=", "0"}], TraditionalForm]]],
  ". Consequently, the total work done on the mass during the fall must be 0, \
i.e., ",
  Cell[BoxData[
      FormBox[
        RowBox[{
          FormBox[\(W\_total\),
            "TraditionalForm"], "=", "0"}], TraditionalForm]]],
  ". \n\nThe forces that do work during the fall are the weight of the mass, \
the pull of the bungee cord, and friction forces due to air resistance and \
the rubbing together of the materials that make up the bungee cord. We will \
ignore the friction forces and consider only the work done by the weight \
force and the bungee force. \n\nThe work done by gravity is easy to calculate \
because the weight force is constant during the fall; therefore, \n\n",
  Cell[BoxData[
      \(TraditionalForm\`W\_gravity\)]],
  Cell[BoxData[
      FormBox[
        RowBox[{"=", 
          RowBox[{
            FormBox[
              RowBox[{
                RowBox[{
                  RowBox[{"(", 
                    StyleBox["mg",
                      FontSlant->"Italic"], ")"}], "d"}], "="}],
              "TraditionalForm"], \((0.2\ kg)\), 
            RowBox[{"(", 
              RowBox[{"9.8", " ", 
                RowBox[{
                  StyleBox["m",
                    FontSlant->"Plain"], "/", 
                  FormBox[\(sec\^2\),
                    "TraditionalForm"]}]}], ")"}], "d", 
            FormBox[\(\(=\)\(\(1.96\)  \(d\)\(\ \)\)\),
              "TraditionalForm"], \((in\ Joules)\)}]}], TraditionalForm]]],
  ", \n\nwhere ",
  StyleBox["d",
    FontSlant->"Italic"],
  " is the fall distance. Now we do it with ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  "."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(workgravity = 0.2*9.8*d\)], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "The work done by the bungee cord is negative because, during the fall, the \
force is in the direction opposite the motion; that is, the bungee cord pulls \
up on the mass as it falls downward. We calculate the work as follows: ",
  Cell[BoxData[
      \(TraditionalForm\`W\_bungee\)]],
  "=",
  Cell[BoxData[
      \(TraditionalForm\`\(\(\ \)\(\(-\)\(\ \)\)\)\)]],
  Cell[BoxData[
      FormBox[
        RowBox[{\(\[Integral]\_0\%d\), 
          RowBox[{\(bungeeforce(\(s - L\)\/L)\), 
            StyleBox[
              RowBox[{
                StyleBox["d",
                  FontSlant->"Plain"], 
                StyleBox["s",
                  FontSlant->"Italic"]}]]}]}], TraditionalForm]]],
  ", where ",
  StyleBox["s",
    FontSlant->"Italic"],
  " is the distance fallen, ",
  Cell[BoxData[
      \(TraditionalForm\`L\)]],
  " is the unstretched length of the bungee cord, and ",
  Cell[BoxData[
      \(TraditionalForm\`\(s - L\)\/L\)]],
  "is the strain in the bungee (i.e., the stretch divided by the unstretched \
length). \n\nThe bungee cord doesn't stretch until the distance fallen is \
greater than the unstretched length of the bungee cord, that is, until ",
  Cell[BoxData[
      \(TraditionalForm\`s > L\)]],
  ". Since the bungee force is defined piecewise, we need to divide the work \
integral into two parts. In the first part, when ",
  Cell[BoxData[
      \(TraditionalForm\`s < L\)]],
  ", the bungee cord force is 0 and so the work done is 0. In the second \
part, when ",
  Cell[BoxData[
      \(TraditionalForm\`s > L\)]],
  ", the bungee cord force is given by our ",
  StyleBox["y[x_]",
    FontWeight->"Bold"],
  " function. We now use ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " to calculate this second integral."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(Clear[workbungee];\)\), "\n", 
    \(workbungee = \(-\(\[Integral]\_L\%d 
              y[\(s - L\)\/L] \[DifferentialD]s\)\)\)}], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "We're almost done. Let's calculate the total work, set it equal to 0, and \
solve for ",
  StyleBox["d",
    FontSlant->"Italic"],
  " in terms of ",
  StyleBox["L",
    FontSlant->"Italic"],
  "."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(Clear[totalwork, d];\)\), "\n", 
    \(totalwork = workgravity + workbungee\)}], "Input",
  PageWidth->PaperWidth],

Cell[TextData[{
  "If you try to set ",
  StyleBox["totalwork",
    FontWeight->"Bold"],
  " equal to 0 and use ",
  StyleBox["Mathematica'",
    FontSlant->"Italic"],
  "s ",
  StyleBox["Solve[ ]",
    FontWeight->"Bold"],
  " command to find ",
  Cell[BoxData[
      \(TraditionalForm\`L\)]],
  " in terms of ",
  StyleBox["d",
    FontSlant->"Italic"],
  ", our original challenge, you will find that it won't work. Rats! But \
we're too far along to give up now. Let's try this: assign different values \
to ",
  StyleBox["d",
    FontSlant->"Italic"],
  ", use the ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " command to calculate ",
  StyleBox["L",
    FontSlant->"Italic"],
  " for each of the ",
  StyleBox["d",
    FontSlant->"Italic"],
  " values, then plot ",
  Cell[BoxData[
      \(TraditionalForm\`L\)]],
  " versus ",
  StyleBox["d",
    FontSlant->"Italic"],
  ", and see if there is a pattern. There should be."
}], "Text",
  PageWidth->PaperWidth],

Cell[TextData[{
  "First, let's see how the ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " command works. We assign a value to ",
  StyleBox["d",
    FontSlant->"Italic"],
  " and then use ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " to determine the corresponding value for ",
  StyleBox["L",
    FontSlant->"Italic"],
  "."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(d = 1;\)\), "\n", 
    \(FindRoot[totalwork \[Equal] 0, {L, 0.1}]\)}], "Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h6",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h6b"],

Cell[TextData[{
  "The answer seems a reasonable one. The model says that if the fall \
distance is 1 meter, then we should cut the bungee cord so that the part of \
the cord that stretches during the fall is 0.655 meters long. Don't forget \
that you need a length of cord in addition to the calculated length so that \
you can tie the cord to the mass and to the support. \n\nNote also that to \
determine ",
  StyleBox["d",
    FontSlant->"Italic"],
  ", the fall distance, you have to be sure to take the distance from the \
support to the floor and subtract the length of the mass. We want ",
  StyleBox["d ",
    FontSlant->"Italic"],
  "to be the stretched length of the cord when the mass just kisses the \
ground; therefore, the total distance from the support to the floor will be \
",
  StyleBox["d",
    FontSlant->"Italic"],
  " plus the length of the mass. "
}], "Text",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell["Part VI: Making Predictions", "Section",
  PageWidth->PaperWidth],

Cell[TextData[{
  "In this Part, we build a table of ordered pairs in which the first entry \
in each ordered pair is the fall distance ",
  StyleBox["d",
    FontSlant->"Italic"],
  ", and the second element is the required length of cord (not including the \
tie ends). The output from ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " is a list with the rule ",
  Cell[BoxData[
      \(TraditionalForm\`L \[Rule] 0.655219\)]],
  " inside. To extract the number 0.655219, we use a pair of double square \
brackets as follows."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(soln = 
        FindRoot[
          totalwork \[Equal] 0, {L, 0.1}];\)\), "\[IndentingNewLine]", 
    \(soln[\([1, 2]\)]\)}], "Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    ButtonBox[
      ButtonBox[
        RowBox[{
          StyleBox["\[MathematicaIcon]",
            FontSize->18,
            FontWeight->"Bold",
            FontColor->RGBColor[0.792981, 0.777356, 0.144533],
            FontVariations->{"CompatibilityType"->0}], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["About",
            FontSize->14,
            FontWeight->"Bold",
            FontColor->RGBColor[0.500008, 0, 0.500008]], 
          StyleBox[" ",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic"], 
          StyleBox["Mathematica",
            FontSize->14,
            FontWeight->"Bold",
            FontSlant->"Italic",
            FontColor->RGBColor[0.500008, 0, 0.500008]]}],
        ButtonStyle->"Hyperlink"],
      ButtonData:>"h7",
      ButtonStyle->"Hyperlink"]], "Input",
  PageWidth->PaperWidth,
  Evaluatable->False,
  CellTags->"h7b"],

Cell[TextData[{
  "Now, we use the ",
  StyleBox["Table[ ]",
    FontWeight->"Bold"],
  " command to build a set of ordered pairs, in which the first element of \
each ordered pair is the fall distance ",
  StyleBox["d",
    FontSlant->"Italic"],
  ", and the second element is the required bungee cord length, not including \
the tie ends."
}], "Text",
  PageWidth->PaperWidth],

Cell[BoxData[{
    \(\(Clear[d];\)\), "\n", 
    \(\(dversusL = 
        Table[{d, \(FindRoot[totalwork \[Equal] 0, {L, 0.1}]\)[\([1, 
                2]\)]}, {d, 0.5, 10, 0.5}];\)\), "\[IndentingNewLine]", 
    \(TableForm[dversusL, 
      TableHeadings \[Rule] {None, {"\<Fall Distance (m)\>", "\<Bungee Length \
(m)\>"}}]\)}], "Input",
  PageWidth->PaperWidth],

Cell["Let's plot them.", "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(p3 = 
        ListPlot[dversusL, 
          PlotStyle -> {PointSize[0.02], RGBColor[0.996109, \ 0, \ 0]}, 
          AxesLabel \[Rule] {"\<Fall(m)\>", "\<Cord Length(m)\>"}, 
          AxesOrigin \[Rule] {0, 0}, 
          PlotRange \[Rule] {{0, 10}, {0, 7}}];\)\)], "Input",
  PageWidth->PaperWidth],

Cell["\<\
It looks like a straight line through the origin, which is rather surprising. \
You know what to do next.\
\>", "Text",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(L[d_] = Fit[dversusL, {d}, d]\)], "Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(p4 = 
        Plot[L[d], {d, 0, 10}, 
          PlotStyle -> {RGBColor[0, 0, 1], Thickness[0.007]}, 
          AxesLabel \[Rule] {"\<Fall(m)\>", "\<Cord Length(m)\>"}];\)\)], \
"Input",
  PageWidth->PaperWidth],

Cell[BoxData[
    \(\(Show[p4, p3];\)\)], "Input",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell["Part VII: Testing the Results", "Section",
  PageWidth->PaperWidth],

Cell["\<\
The Carroll College students who tested the model found that it worked \
extremely well. For various fall distances, the cord was cut to just the \
right length so that the mass kissed the floor when dropped. This provided a \
good validation of the model.\
\>", "Text",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell["You Try It: Do Your Own Experiment", "Section",
  PageWidth->PaperWidth],

Cell["\<\
Go to a sporting goods store and get some small bungee cord material \
(one-eighth inch in diameter or so) and a small inexpensive metric tape \
measure. (In sporting goods, bungee cord is sometimes called shock cord.) \
Then, go to your physics department and borrow some calibrated masses. See if \
you can replicate this modeling exercise. The data you get will likely differ \
from ours because your bungee cord material probably won't be the same. But, \
we hope your results will be as good.\
\>", "Text",
  PageWidth->PaperWidth]
}, Closed]],

Cell[CellGroupData[{

Cell[TextData[{
  StyleBox["\[MathematicaIcon]",
    FontWeight->"Bold",
    FontColor->RGBColor[0.792981, 0.777356, 0.144533],
    FontVariations->{"CompatibilityType"->0}],
  StyleBox[" ",
    FontWeight->"Bold",
    FontSlant->"Italic"],
  StyleBox["About",
    FontWeight->"Bold",
    FontColor->RGBColor[0.500008, 0, 0.500008]],
  StyleBox[" ",
    FontWeight->"Bold",
    FontSlant->"Italic"],
  StyleBox["Mathematica",
    FontWeight->"Bold",
    FontSlant->"Italic",
    FontColor->RGBColor[0.500008, 0, 0.500008]]
}], "Section",
  PageWidth->PaperWidth,
  CellDingbat->None],

Cell[TextData[{
  "The semicolon after a ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " command suppresses the output. In the preceding command cell, we grouped \
the data list command and the ",
  StyleBox["TableForm[ ] ",
    FontWeight->"Bold"],
  "command together in one cell with a semicolon after the definition of the \
data list and no semicolon after ",
  StyleBox["TableForm[ ]",
    FontWeight->"Bold"],
  ". In this way the data table is displayed for easy reading, and the data \
list is suppressed. If you remove the semicolon, both forms of the data are \
displayed. ",
  ButtonBox["Go Back.",
    ButtonData:>"h1b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h1"],

Cell[TextData[{
  "You can include comments in a ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " command cell by enclosing the comment inside ",
  StyleBox["(*   *)",
    FontWeight->"Bold"],
  ",",
  StyleBox[" ",
    FontWeight->"Bold"],
  "as we did in the preceding command. This can be useful for documenting \
your work, which is good programming practice. When ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " executes a command, it ignores everything enclosed by the ",
  StyleBox["(*  *)",
    FontWeight->"Bold"],
  " markers. ",
  ButtonBox["Go Back.",
    ButtonData:>"h2b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h2"],

Cell[TextData[{
  "Among other things, ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " is a programming language. When we group a series of commands together in \
a single cell, as in the cell that follows, we are essentially writing a ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " program. Although we have not done it here, we could give this group of \
commands a symbol name and use it like any other ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " command. We do this with the ",
  StyleBox["Block[ ]",
    FontWeight->"Bold"],
  " command or the ",
  StyleBox["Module[ ]",
    FontWeight->"Bold"],
  " command. To learn more about programming in ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  ", see \"Overview of ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  ": Making Your Own Commands,\" included in this supplement. ",
  ButtonBox["Go back.",
    ButtonData:>"h3b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h3"],

Cell[TextData[{
  "You may have noticed that when a semicolon follows a graphics command like \
",
  StyleBox["Plot[ ]",
    FontWeight->"Bold"],
  " or ",
  StyleBox["ListPlot[ ]",
    FontWeight->"Bold"],
  ", the graphics output is not suppressed as it is for most other ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " commands. If you want to suppress a graphics display, do what we did in \
the preceding set of commands. As an option in the ",
  StyleBox["Plot[ ]",
    FontWeight->"Bold"],
  " command, we type ",
  StyleBox["DisplayFunction\[Rule]Identity",
    FontWeight->"Bold"],
  ",",
  " and the display is suppressed. Later, when we want to display the \
graphics in the ",
  StyleBox["Show[ ]",
    FontWeight->"Bold"],
  " command, we type ",
  StyleBox["DisplayFunction\[RightArrow]$DisplayFunction",
    FontWeight->"Bold"],
  " as an option. Specifying options in a graphics command is very useful for \
tailoring your graphics output. To learn more about the various options for \
graphics commands, go to the Help Browser, type ",
  StyleBox["Plot",
    FontWeight->"Bold"],
  ", and then scroll down to see some of the options that are available. ",
  ButtonBox["Go Back.",
    ButtonData:>"h4b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h4"],

Cell[TextData[{
  "The ",
  StyleBox["Which[ ] ",
    FontWeight->"Bold"],
  "command is very useful for functions like the bungee cord force that are \
piecewise defined. Many mathematical operations can be done in ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " on functions that are defined in this way. For more information about the \
",
  StyleBox["Which[ ]",
    FontWeight->"Bold"],
  " command and related commands like ",
  StyleBox["If[ ]",
    FontWeight->"Bold"],
  " and ",
  StyleBox["Switch[ ]",
    FontWeight->"Bold"],
  ", ",
  "go to the Help Browser, select Programming in the left column of the \
dialog box, and then select Flow Control in the center column. ",
  ButtonBox["Go Back.",
    ButtonData:>"h5b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h5"],

Cell[TextData[{
  "The ",
  StyleBox["Solve[ ]",
    FontWeight->"Bold"],
  " command is used to solve algebraic equations. When the equations are \
non-algebraic, however, the ",
  StyleBox["Solve[ ]",
    FontWeight->"Bold"],
  " command often won't work. This is the case with the problem we are trying \
to solve. The next alternative is to use a numerical approach with the ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " command. This command almost always finds a numeric estimate of a root, \
but it won't work on equations that have variables in them, other than the \
unknown. The first argument in ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " is the equation to be solved. (Note that mathematical equalities are \
expressed with the double equals, \"",
  Cell[BoxData[
      \(TraditionalForm\` == \)]],
  "\", because the single equal sign is reserved for the assignment of values \
or expressions to symbol names. An example is the assignment to ",
  StyleBox["totalwork",
    FontWeight->"Bold"],
  " in one of the preceding cells.) The second argument of ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " is a list; the first element of the list is the variable we wish to solve \
for, and the second is an initial estimate of the solution. We selected an \
initial estimate of 0.1 in our use of ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " in the preceding cell. To learn more about ",
  StyleBox["Solve[ ] ",
    FontWeight->"Bold"],
  "and ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  ",",
  StyleBox[" ",
    FontWeight->"Bold"],
  "go to the Help Browser and type ",
  StyleBox["Solve",
    FontWeight->"Bold"],
  " and/or ",
  StyleBox["FindRoot",
    FontWeight->"Bold"],
  ". ",
  ButtonBox["Go Back.",
    ButtonData:>"h6b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h6"],

Cell[TextData[{
  "The output list that we get when we use ",
  StyleBox["FindRoot[ ]",
    FontWeight->"Bold"],
  " in the preceding cell has one element with two parts, the variable name \
and the solution value for that variable. Therefore, to extract the solution, \
we use pairs of double brackets with part designations, as in the preceding \
cell. To learn more about extracting elements from expressions and lists, see \
\"Overview of ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  ": Parts of Lists,\" and go to the Help Browser and type ",
  StyleBox["List",
    FontWeight->"Bold"],
  " and/or ",
  StyleBox["Part",
    FontWeight->"Bold"],
  ". ",
  ButtonBox["Go Back.",
    ButtonData:>"h7b",
    ButtonStyle->"Hyperlink"]
}], "Text",
  PageWidth->PaperWidth,
  CellTags->"h7"]
}, Closed]]
}, Open  ]]
},
FrontEndVersion->"4.0 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 695}},
AutoGeneratedPackage->None,
WindowSize->{714, 664},
WindowMargins->{{0, Automatic}, {-1, Automatic}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic}
]


(***********************************************************************
Cached data follows.  If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of 
the file.  The cache data will then be recreated when you save this file 
from within Mathematica.
***********************************************************************)

(*CellTagsOutline
CellTagsIndex->{
  "h1b"->{
    Cell[7002, 179, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h1b"]},
  "h2b"->{
    Cell[9862, 276, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h2b"]},
  "h3b"->{
    Cell[17384, 470, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h3b"]},
  "h4b"->{
    Cell[19392, 525, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h4b"]},
  "h5b"->{
    Cell[21734, 599, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h5b"]},
  "h6b"->{
    Cell[31163, 893, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h6b"]},
  "h7b"->{
    Cell[33957, 978, 1010, 31, 44, "Input",
      Evaluatable->False,
      CellTags->"h7b"]},
  "h1"->{
    Cell[38364, 1124, 729, 20, 109, "Text",
      CellTags->"h1"]},
  "h2"->{
    Cell[39096, 1146, 692, 23, 90, "Text",
      CellTags->"h2"]},
  "h3"->{
    Cell[39791, 1171, 1016, 30, 128, "Text",
      CellTags->"h3"]},
  "h4"->{
    Cell[40810, 1203, 1315, 37, 185, "Text",
      CellTags->"h4"]},
  "h5"->{
    Cell[42128, 1242, 827, 26, 109, "Text",
      CellTags->"h5"]},
  "h6"->{
    Cell[42958, 1270, 1888, 54, 242, "Text",
      CellTags->"h6"]},
  "h7"->{
    Cell[44849, 1326, 801, 23, 109, "Text",
      CellTags->"h7"]}
  }
*)

(*CellTagsIndex
CellTagsIndex->{
  {"h1b", 46366, 1372},
  {"h2b", 46471, 1376},
  {"h3b", 46576, 1380},
  {"h4b", 46682, 1384},
  {"h5b", 46788, 1388},
  {"h6b", 46894, 1392},
  {"h7b", 47000, 1396},
  {"h1", 47105, 1400},
  {"h2", 47183, 1403},
  {"h3", 47260, 1406},
  {"h4", 47339, 1409},
  {"h5", 47418, 1412},
  {"h6", 47496, 1415},
  {"h7", 47575, 1418}
  }
*)

(*NotebookFileOutline
Notebook[{

Cell[CellGroupData[{
Cell[1739, 51, 94, 1, 195, "Title"],
Cell[1836, 54, 185, 5, 37, "Text"],
Cell[2024, 61, 136, 4, 19, "Input",
  CellOpen->False,
  InitializationCell->True],

Cell[CellGroupData[{
Cell[2185, 69, 71, 1, 53, "Section"],
Cell[2259, 72, 1190, 20, 280, "Text"],

Cell[CellGroupData[{
Cell[3474, 96, 99, 2, 47, "Subsection"],
Cell[3576, 100, 1415, 36, 299, "Text"]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{
Cell[5040, 142, 66, 1, 33, "Section"],
Cell[5109, 145, 1613, 24, 337, "Text"],
Cell[6725, 171, 274, 6, 90, "Input"],
Cell[7002, 179, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h1b"],
Cell[8015, 212, 232, 6, 70, "Input"]
}, Closed]],

Cell[CellGroupData[{
Cell[8284, 223, 70, 1, 33, "Section"],
Cell[8357, 226, 627, 18, 90, "Text"],
Cell[8987, 246, 147, 4, 70, "Input"],
Cell[9137, 252, 246, 8, 52, "Text"],
Cell[9386, 262, 231, 6, 70, "Input"],
Cell[9620, 270, 239, 4, 70, "Input"],
Cell[9862, 276, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h2b"]
}, Closed]],

Cell[CellGroupData[{
Cell[10909, 312, 74, 1, 33, "Section"],
Cell[10986, 315, 579, 10, 147, "Text"],
Cell[11568, 327, 336, 7, 110, "Input"],
Cell[11907, 336, 151, 4, 33, "Text"],
Cell[12061, 342, 217, 5, 70, "Input"],
Cell[12281, 349, 355, 8, 90, "Text"],
Cell[12639, 359, 146, 4, 50, "Input"],
Cell[12788, 365, 1773, 29, 356, "Text"],
Cell[14564, 396, 132, 3, 30, "Input"],
Cell[14699, 401, 128, 4, 33, "Text"],
Cell[14830, 407, 99, 2, 30, "Input"],
Cell[14932, 411, 411, 9, 90, "Text"],
Cell[15346, 422, 90, 2, 30, "Input"],
Cell[15439, 426, 235, 6, 71, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[15711, 437, 75, 1, 33, "Section"],
Cell[15789, 440, 1592, 28, 318, "Text"],
Cell[17384, 470, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h3b"],
Cell[18397, 503, 992, 20, 310, "Input"],
Cell[19392, 525, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h4b"]
}, Closed]],

Cell[CellGroupData[{
Cell[20439, 561, 74, 1, 33, "Section"],
Cell[20516, 564, 568, 11, 109, "Text"],
Cell[21087, 577, 174, 4, 50, "Input"],
Cell[21264, 583, 232, 7, 52, "Text"],
Cell[21499, 592, 232, 5, 70, "Input"],
Cell[21734, 599, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h5b"],
Cell[22747, 632, 320, 6, 71, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[23104, 643, 67, 1, 33, "Section"],
Cell[23174, 646, 141, 4, 33, "Text"],
Cell[23318, 652, 3848, 99, 530, "Text"],
Cell[27169, 753, 81, 2, 30, "Input"],
Cell[27253, 757, 1821, 49, 229, "Text"],
Cell[29077, 808, 187, 4, 63, "Input"],
Cell[29267, 814, 253, 10, 33, "Text"],
Cell[29523, 826, 137, 3, 50, "Input"],
Cell[29663, 831, 978, 38, 90, "Text"],
Cell[30644, 871, 386, 15, 52, "Text"],
Cell[31033, 888, 127, 3, 50, "Input"],
Cell[31163, 893, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h6b"],
Cell[32176, 926, 909, 20, 185, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[33122, 951, 71, 1, 33, "Section"],
Cell[33196, 954, 573, 15, 90, "Text"],
Cell[33772, 971, 182, 5, 50, "Input"],
Cell[33957, 978, 1010, 31, 44, "Input",
  Evaluatable->False,
  CellTags->"h7b"],
Cell[34970, 1011, 378, 11, 71, "Text"],
Cell[35351, 1024, 363, 8, 130, "Input"],
Cell[35717, 1034, 57, 1, 33, "Text"],
Cell[35777, 1037, 322, 7, 90, "Input"],
Cell[36102, 1046, 154, 4, 33, "Text"],
Cell[36259, 1052, 87, 2, 30, "Input"],
Cell[36349, 1056, 232, 6, 70, "Input"],
Cell[36584, 1064, 75, 2, 30, "Input"]
}, Closed]],

Cell[CellGroupData[{
Cell[36696, 1071, 73, 1, 33, "Section"],
Cell[36772, 1074, 305, 6, 71, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[37114, 1085, 78, 1, 33, "Section"],
Cell[37195, 1088, 546, 9, 109, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[37778, 1102, 583, 20, 33, "Section"],
Cell[38364, 1124, 729, 20, 109, "Text",
  CellTags->"h1"],
Cell[39096, 1146, 692, 23, 90, "Text",
  CellTags->"h2"],
Cell[39791, 1171, 1016, 30, 128, "Text",
  CellTags->"h3"],
Cell[40810, 1203, 1315, 37, 185, "Text",
  CellTags->"h4"],
Cell[42128, 1242, 827, 26, 109, "Text",
  CellTags->"h5"],
Cell[42958, 1270, 1888, 54, 242, "Text",
  CellTags->"h6"],
Cell[44849, 1326, 801, 23, 109, "Text",
  CellTags->"h7"]
}, Closed]]
}, Open  ]]
}
]
*)




(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)