3.3 Rates of Change in the Sciences

Mathematica script by Chris Parrish,
   cparrish@sewanee.edu

Problems from James Stewart,
  "Calculus: Concepts and Contexts,"
  Second Edition, Brooks/Cole, 2001

Lactonization

Stewart, Exercise 3.3.16

The following data concerns the lactonization of a certain acid. See Stewart, Exercise 3.3.16, for details.

In[153]:=

<<Graphics`Colors`

In[154]:=

Clear[c, t, data, dots, dotPlot, interp, approximation, y, curvePlot]  RowBox[{RowBox[ ... sp;     TableHeadings {{"t", "c(t)"}, None}]

Out[158]//TableForm=

t 0 2 4 6 8
c(t) 0.08 0.057 0.0408 0.0295 0.021

In[159]:=

dots = Transpose[data] ;  RowBox[{RowBox[{dotPlot,  , =,  , RowBox[{ListPlot, [, RowBo ... ;, AxesLabel  {"t (minutes)", "c(t) (moles per liter)"}}], ]}]}], ;}]

[Graphics:HTMLFiles/3.3_ratesSciences_4.gif]

In[161]:=

interp = Fit[dots, {1, x, x^2, x^3}, x]

Out[161]=

RowBox[{RowBox[{0.0800029, }], -, RowBox[{0.0135512,  , x}], +, RowBox[{0.00110536,  , x^2}], -, RowBox[{0.0000416667,  , x^3}]}]

In[162]:=

approximation[y_] := (interp /. x  y)  curvePlot = Plot[approximation[y], {y,  ... p;  AxesLabel  {"t (minutes)", "c(t) (moles per liter)"}] ;

[Graphics:HTMLFiles/3.3_ratesSciences_8.gif]

In[164]:=

Show[curvePlot, dotPlot] ;

[Graphics:HTMLFiles/3.3_ratesSciences_10.gif]

Use the approximating poynomial to estimate the rates of growth in 1920, 1980, and 1985.

In[165]:=

Print["The rate of growth of the reaction at t = 2 was approximately ", approximation '[2], " moles per liter per minute."]

RowBox[{The rate of growth of the reaction at t = 2 was approximately , , RowBox[{-, 0.00962976}], ,  moles per liter per minute.}]

The reaction is slowing down. It's rate of change is negative.

World Population

Stewart, Exercise 3.3.17

Consider the population of the world over the course of the last century.

In[166]:=

Clear[pops, years, worldPop, data, dotPlot, curvePlot, interp, worldPopulation]  pops  ... bsp;TableHeadings {{"year", "world population (in millions)"}, None}]

Out[170]//TableForm=

year 1900 1910 1920 1930 1940 1950 1960 1970 1980 1990 2000
world population (in millions) 1650 1750 1860 2070 2300 2560 3040 3710 4450 5280 6070

In[171]:=

data = Transpose[worldPop] ;  RowBox[{RowBox[{dotPlot,  , =,  , RowBox[{ListPlot, [, R ...  , AxesLabel  {"year", "population (in millions)"}}], ]}]}], ;}]

[Graphics:HTMLFiles/3.3_ratesSciences_15.gif]

In[173]:=

interp = Fit[data, {1, x, x^2, x^3}, x]

Out[173]=

RowBox[{RowBox[{-, 7.31843*10^6}], +, RowBox[{12165.1,  , x}], -, RowBox[{6.72226,  , x^2}], +, RowBox[{0.00123543,  , x^3}]}]

In[174]:=

worldPopulation[y_] := (interp /. x  y)  curvePlot = Plot[worldPopulation[y],  ... ;   AxesLabel  {"year", "population (in millions)"}] ;

[Graphics:HTMLFiles/3.3_ratesSciences_19.gif]

In[176]:=

Show[curvePlot, dotPlot] ;

[Graphics:HTMLFiles/3.3_ratesSciences_21.gif]

Use the approximating poynomial to estimate the rates of growth in 1920, 1980, and 1985.

In[177]:=

Print["The rate of growth of the world population in 1920 was approximately ", world ... in 1985 was approximately ", worldPopulation '[1985], " million people per year."]

RowBox[{The rate of growth of the world population in 1920 was approximately , , 14.4814, ,  million people per year.}]

RowBox[{The rate of growth of the world population in 1980 was approximately , , 75.0828, ,  million people per year.}]

RowBox[{The rate of growth of the world population in 1985 was approximately , , 81.3374, ,  million people per year.}]

Let's check that last result by plotting the associated tangent line on the previous graph.

In[180]:=

a = 1985 ; b = worldPopulation[1985] ; m = worldPopulation '[1985] ;  tan[y_] := m (y  ... nbsp;          PlotStyle  BurntUmber] ;

[Graphics:HTMLFiles/3.3_ratesSciences_27.gif]

In[185]:=

Show[curvePlot, dotPlot, tanPlot] ;

[Graphics:HTMLFiles/3.3_ratesSciences_29.gif]


Created by Mathematica  (April 19, 2004)