(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 6.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[      7584,        280]
NotebookOptionsPosition[      5997,        223]
NotebookOutlinePosition[      6485,        242]
CellTagsIndexPosition[      6442,        239]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Problem 4, page 105", "Title",
 TextAlignment->Center],

Cell["\<\
In the following data, V represents a mean walking velocity and P represents \
the population size.  The ordered pairs are of the form (V,P).   We wish to \
know if we can predict the population size P by observing how fast people \
walk.  Plot the data.  What kind of relationship is suggested?  Test the \
following models by plotting the appropriate transformed data.\
\>", "Text"],

Cell[CellGroupData[{

Cell["The data and graph", "Section"],

Cell[BoxData[
 RowBox[{"w", "=", 
  RowBox[{"Table", "[", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"2.27", ",", "2500"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"2.76", ",", "365"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"3.27", ",", "23700"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"3.31", ",", "5491"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"3.70", ",", "14000"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"3.85", ",", "78200"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"4.31", ",", "70700"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"4.39", ",", "138000"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"4.42", ",", "304500"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"4.81", ",", "341948"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"4.9", ",", "49375"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"5.05", ",", "260200"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"5.21", ",", "867023"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"5.62", ",", "1340000"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"5.88", ",", "1092759"}], "}"}]}], "}"}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"graphw", "=", 
  RowBox[{"ListPlot", "[", "w", "]"}]}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Model #1:  P=aV^b", "Section"],

Cell[CellGroupData[{

Cell["Transformed data and graph", "Subsubsection"],

Cell[BoxData[
 RowBox[{"tw", "=", 
  RowBox[{"Table", "[", 
   RowBox[{
    RowBox[{"{", " ", 
     RowBox[{
      RowBox[{"Log", "[", 
       RowBox[{"w", "[", 
        RowBox[{"[", 
         RowBox[{"i", ",", "1"}], "]"}], "]"}], "]"}], ",", 
      RowBox[{"Log", "[", 
       RowBox[{"w", "[", 
        RowBox[{"[", 
         RowBox[{"i", ",", "2"}], "]"}], "]"}], "]"}]}], " ", "}"}], ",", 
    RowBox[{"{", 
     RowBox[{"i", ",", "1", ",", "15"}], "}"}]}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"graphtw", "=", 
  RowBox[{"ListPlot", "[", "tw", "]"}]}]], "Input"],

Cell["\<\
The transformed data points rougly lie on a line, so we proceed to use this \
model. We want to find the equation of the line that best fits the data.\
\>", "Text"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Fitting a line to data b, graph of line with data", "Subsubsection"],

Cell[BoxData[
 RowBox[{"linefit", "=", 
  RowBox[{"Fit", "[", 
   RowBox[{"tw", ",", 
    RowBox[{"{", 
     RowBox[{"1", ",", "x"}], "}"}], ",", "x"}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"lineplot", "=", 
  RowBox[{"Plot", "[", 
   RowBox[{"linefit", ",", 
    RowBox[{"{", 
     RowBox[{"x", ",", "0", ",", "2"}], "}"}], ",", 
    RowBox[{"PlotRange", "->", 
     RowBox[{"{", 
      RowBox[{"0", ",", "16"}], "}"}]}]}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"Show", "[", 
  RowBox[{"lineplot", ",", "graphtw"}], "]"}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Now look at original data with approximation P=aV^b", "Subsubsection"],

Cell[BoxData[
 RowBox[{
  RowBox[{"p", "[", "x_", "]"}], "=", 
  RowBox[{
   RowBox[{"Exp", "[", 
    RowBox[{"-", ".22658"}], "]"}], "*", 
   RowBox[{"x", "^", "8.00629"}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"graphp", "=", 
   RowBox[{"Plot", "[", 
    RowBox[{
     RowBox[{"p", "[", "x", "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", ",", "2", ",", "6"}], "}"}]}], "]"}]}], "\n"}]], "Input"],

Cell[BoxData[
 RowBox[{"Show", "[", 
  RowBox[{"graphw", ",", "graphp"}], "]"}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Let's compute the maximum absolute error.", "Subsection"],

Cell[BoxData[
 RowBox[{"M", "=", 
  RowBox[{"Abs", "[", " ", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"{", " ", 
      RowBox[{
       RowBox[{"w", "[", 
        RowBox[{"[", 
         RowBox[{"i", ",", "2"}], "]"}], "]"}], "-", 
       RowBox[{"p", "[", 
        RowBox[{"w", "[", 
         RowBox[{"[", 
          RowBox[{"i", ",", "1"}], "]"}], "]"}], " ", "]"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "15"}], "}"}]}], "]"}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"Max", "[", "M", "]"}]], "Input"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Model #2:  P=alnV", "Section"],

Cell[BoxData[
 RowBox[{"c", "=", 
  RowBox[{"Table", "[", 
   RowBox[{
    RowBox[{"{", " ", 
     RowBox[{
      RowBox[{"Log", "[", 
       RowBox[{"w", "[", 
        RowBox[{"[", 
         RowBox[{"i", ",", "1"}], "]"}], "]"}], "]"}], ",", 
      RowBox[{"w", "[", 
       RowBox[{"[", 
        RowBox[{"i", ",", "2"}], "]"}], "]"}]}], "}"}], ",", 
    RowBox[{"{", 
     RowBox[{"i", ",", "1", ",", "15"}], "}"}]}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"graphc", "=", 
  RowBox[{"ListPlot", "[", "c", "]"}]}]], "Input"],

Cell["\<\
Here, it appears the model P=alnV is not appropriate, since a line would not \
approximate this transformed data well.\
\>", "Text"]
}, Open  ]]
}, Open  ]]
},
WindowSize->{1035, 771},
WindowMargins->{{87, Automatic}, {54, Automatic}},
DockedCells->FEPrivate`FrontEndResource[
 "FEExpressions", "CompatibilityToolbar"],
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic},
FrontEndVersion->"6.0 for Microsoft Windows (32-bit) (June 19, 2007)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[590, 23, 60, 1, 83, "Title"],
Cell[653, 26, 394, 6, 47, "Text"],
Cell[CellGroupData[{
Cell[1072, 36, 37, 0, 71, "Section"],
Cell[1112, 38, 1164, 34, 52, "Input"],
Cell[2279, 74, 89, 2, 31, "Input"]
}, Open  ]],
Cell[CellGroupData[{
Cell[2405, 81, 36, 0, 71, "Section"],
Cell[CellGroupData[{
Cell[2466, 85, 51, 0, 28, "Subsubsection"],
Cell[2520, 87, 481, 15, 31, "Input"],
Cell[3004, 104, 91, 2, 31, "Input"],
Cell[3098, 108, 174, 3, 29, "Text"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3309, 116, 74, 0, 28, "Subsubsection"],
Cell[3386, 118, 171, 5, 31, "Input"],
Cell[3560, 125, 276, 8, 31, "Input"],
Cell[3839, 135, 93, 2, 31, "Input"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3969, 142, 76, 0, 28, "Subsubsection"],
Cell[4048, 144, 187, 6, 31, "Input"],
Cell[4238, 152, 224, 7, 52, "Input"],
Cell[4465, 161, 90, 2, 31, "Input"]
}, Open  ]],
Cell[CellGroupData[{
Cell[4592, 168, 63, 0, 36, "Subsection"],
Cell[4658, 170, 489, 15, 31, "Input"],
Cell[5150, 187, 56, 1, 31, "Input"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[5255, 194, 36, 0, 71, "Section"],
Cell[5294, 196, 438, 14, 31, "Input"],
Cell[5735, 212, 89, 2, 31, "Input"],
Cell[5827, 216, 142, 3, 29, "Text"]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)