7.4 Applications and Modeling

Mathematica script by Chris Parrish,
   cparrish@sewanee.edu

Sources and references for some of these problems include
    James Stewart, "Calculus: Concepts and Contexts," Second Edition, Brooks/Cole, 2001
    Deborah Hughes-Hallett, Andrew M. Gleason, et. al., "Calculus," Second Edition, John Wiley & Sons, 1998
    Robert Fraga, ed., "Calculus Problems for a New Century," The Mathematical Association of America, 1993

Dead Leaves

Hughes-Hallett, Gleason, et al, Exercise 9.6.1, page 522

In[817]:=

<<Graphics`PlotField`
<<Graphics`Colors`

In[819]:=

Clear[q,t];

DSolve[q'[t] == 3 - 0.75 q[t], q[t],t]

Out[820]=

RowBox[{{, RowBox[{{, RowBox[{q[t], , RowBox[{RowBox[{4.,  , RowBox[{2.71828, ^, RowBo ... {RowBox[{, ^, RowBox[{(, RowBox[{RowBox[{-, 0.75}],  , t}], )}]}],  , C[1]}]}]}], }}], }}]

In[821]:=

RowBox[{RowBox[{RowBox[{q[t_, c_], :=, RowBox[{4, +, RowBox[{c,  , RowBox[{, ^, RowBox ...         PlotStyleRed, PlotRange {0, 5}] ;

[Graphics:HTMLFiles/7.4_modeling_3.gif]

In[823]:=

Clear[f,t,q,a,b,c,d];

f[t_,q_] := 3 - 0.75 q;

a = 0; b = 5;    (* a <= x <= b *)
c = 0; d = 5;    (* c <= y <= d *)

pts = {};

field = PlotVectorField[{1,f[t,q]},
                        {t,a,b},{q,c,d},
                        PlotLabel -> "dq/dt = 3 - 0.75 q",
                        Axes -> True,
                        AxesLabel -> {"t","q"},
                        PlotPoints -> 10,
                        Prolog -> ManganeseBlue,
                        Epilog -> {Red,PointSize[0.02],
                                   Map[Point,pts]}];

[Graphics:HTMLFiles/7.4_modeling_4.gif]

In[829]:=

Show[field, curves] ;

[Graphics:HTMLFiles/7.4_modeling_6.gif]

Physiological Model

Hughes-Hallett, Gleason, et al, Exercise 9.6.2, page 522

In[830]:=

Clear[w,t,c,i];  

(* w = weight in lbs *)
(* t = time in days *)
(* i = calories consumed per day *)
(* c = pounds per calorie *)

c = 1/3500;

DSolve[w'[t] == c (i - 20.0 w[t]), w[t],t]

Out[836]=

RowBox[{{, RowBox[{{, RowBox[{w[t], , RowBox[{RowBox[{0.05,  , RowBox[{2.71828, ^, Row ... x[{, ^, RowBox[{(, RowBox[{RowBox[{-, 0.00571429}],  , t}], )}]}],  , C[1]}]}]}], }}], }}]

In[837]:=

Clear[w,t,i,c1,i1];  

i1 = 3000;
c1 = 160 - 0.05 i1;

w[t_,i_] := 0.05 i + c1 Exp[-0.00571429 t];

Plot[w[t,i1],{t,0,1000},
     PlotStyle->Red,
     PlotLabel->"weight",
     AxesLabel->{"t (days)","w (lbs)"}];

[Graphics:HTMLFiles/7.4_modeling_8.gif]

Rainwater

Hughes-Hallett, Gleason, et al, Exercise 9.4.5, page 522

In[842]:=

Clear[q, h, k] ; <br />(* h = depth of water in barrel *)(* q[h] = quantity of ...  *)(* q[h] = πr^2h *) DSolve[h '[t]  -k Sqrt[h[t]], h[t], t]

Out[843]=

{{h[t] 1/4 (k^2 t^2 - 2 k t C[1] + C[1]^2)}}

In[844]:=

(* h[0] = 36 => c[1] = 6 *)
(* h[1] = 35 => (-k/2 + 6)^2 = 35 *)

Solve[(-k/2 + 6)^2 == 35,k]

Out[846]=

{{k2 (6 - 35^(1/2))}, {k2 (6 + 35^(1/2))}}

In[847]:=

k1 = (24 - 4 35^(1/2))/2//N ; k2 = (24 - 4 35^(1/2))/2//N ; Print["k1 = ", k1, " and k2 = ", k2]

RowBox[{k1 = , , 0.16784, ,  and k2 = , , 0.16784}]

In[850]:=

h1[t_] := (-k1 t/2 + 6)^2 h2[t_] := (-k2 t/2 + 6)^2 Plot[{h1[t], h2[t]}, {t, 0, 1}, PlotStyle {Red, Blue}] ;

[Graphics:HTMLFiles/7.4_modeling_15.gif]

Reject solution h2[t] since water cannot come back into the barrel.

In[853]:=

Plot[h1[t],{t,0,80},
     PlotStyle->Red,
     PlotLabel->"Water Depth",
     AxesLabel->{"t (hrs)","h (in)"}];

[Graphics:HTMLFiles/7.4_modeling_16.gif]

In[854]:=

Solve[h1[t] == 0,t]

Out[854]=

RowBox[{{, RowBox[{RowBox[{{, RowBox[{t, , 71.4965}], }}], ,, RowBox[{{, RowBox[{t, , 71.4965}], }}]}], }}]

Bank Account

Hughes-Hallett, Gleason, et al, Exercise 9.4.8, page 523

In[855]:=

Clear[b,t];

(* t = time in yrs *)
(* b[t] = balance at time t *)

DSolve[b'[t] == 0.05 b[t] - 12000, b[t],t]

Out[858]=

RowBox[{{, RowBox[{{, RowBox[{b[t], , RowBox[{RowBox[{240000.,  , RowBox[{2.71828, ^,  ... ], +, RowBox[{RowBox[{, ^, RowBox[{(, RowBox[{0.05,  , t}], )}]}],  , C[1]}]}]}], }}], }}]

In[859]:=

RowBox[{(* b[0] = b0 = > c = b0 - 24000 *), , , RowBox[{Clear[c, b0] ;,  ...  ;}], <br />, , c = b0 - 240000 ;, <br />, , soln = Solve[b[20] 0, b0]}]}]

Out[862]=

RowBox[{{, RowBox[{{, RowBox[{b0, , 151709.}], }}], }}]

In[863]:=

b0 = 151709;

Plot[b[t],{t,0,20},
     PlotLabel->"Account Balance",
     AxesLabel->{"t (yrs","balance ($)"},
     PlotStyle->Red];

[Graphics:HTMLFiles/7.4_modeling_21.gif]

Ebbinghaus Model of Forgetting

Hughes-Hallett, Gleason, et al, Exercise 9.4.11, page 523

In[865]:=

Clear[y,t,a,k];

(* t = time in wks *)
(* y[t] = fraction remembered at time t *)

DSolve[y'[t] == k (y[t] - a), y[t],t]

Out[868]=

{{y[t] a + ^(k t) C[1]}}

In[869]:=

(* y[0] = 1 => c = 1 - a *)

y[t_] := a + (1 - a) Exp[k t];

a is the fraction remembered forever.
k determines the rate of forgetting the portion that is lost.

Drug Concentration

Hughes-Hallett, Gleason, et al, Exercise 9.4.13, page 524

In[871]:=

Clear[q,t,r,a,c];

(* t = time in hrs *)
(* q[t] = quantity present at time t *)
(* r = rate drug is administered *)
(* a q[t] = rate drug is excreted *)

DSolve[q'[t] == r - a q[t], q[t],t]

Out[876]=

{{q[t] r/a + ^(-a t) C[1]}}

In[877]:=

Clear[q,t,r,a];

(* q[0] = 0 => c = - r/a *)

q[t_,r_] := r/a (1 - Exp[-a t]);

Choose convenient values for r, a, and c to graph a member of this family of functions.

In[880]:=

r = a = 1;

Plot[q[t,r],{t,0,10},
     PlotStyle->Red,
     PlotRange->{0,1.4}];

[Graphics:HTMLFiles/7.4_modeling_24.gif]

Q_infinity = r/a.
Doubling r will double Q_infinity.

In[882]:=

r = 2;

Plot[q[t,r],{t,0,10},
     PlotStyle->Red,
     PlotRange->{0,2.5}];

[Graphics:HTMLFiles/7.4_modeling_25.gif]

In[884]:=

soln1 = Solve[q[t,1] == 1/(2a),t]
soln2 = Solve[q[t,2] == 2/(2a),t]

Solve :: ifun : Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution information.  More…

Out[884]=

{{tLog[2]}}

Solve :: ifun : Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution information.  More…

Out[885]=

{{tLog[2]}}

Conclusion: r has no effect on the time it takes to reach (1/2) Q_0.

In[886]:=

Clear[q,t,r,a];

q[t_,a_] := r/a (1 - Exp[-a t]);

r = 1;
a = 2;

Plot[q[t,a],{t,0,10},
     PlotStyle->Red,
     PlotRange->{0,0.6}];

[Graphics:HTMLFiles/7.4_modeling_30.gif]

Q_infinity = r/a.
Doubling a will halve Q_infinity.

In[891]:=

Clear[q,t,r,a];

q[t_,a_] := r/a (1 - Exp[-a t]);

(* a = 1; 1/2 q0 = r/2 *)

soln1 = Solve[q[t,1] == r/2,t]

(* a = 2; 1/2 q0 = r/4 *)

soln2 = Solve[q[t,2] == r/4,t]

Solve :: ifun : Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution information.  More…

Out[894]=

{{tLog[2]}}

Solve :: ifun : Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution information.  More…

Out[896]=

{{tLog[2]/2}}

Conclusion: doubling a reduces the time it takes to reach (1/2) Q_0
from Sqrt[2] to Log[Sqrt[2]] when r = 1.

Salt in the Swimming Pool

Hughes-Hallett, Gleason, et al, Exercise 9.4.16, page 524

In[897]:=

Clear[s, t, vol] ; (* t = time in min *)(* s[t] = amount of salt at ti ...  vol = 2  10^6 ;  DSolve[s '[t] 60 * 10 - 60 s[t]/vol, s[t], t]

Out[899]=

{{s[t] 20000000 + ^(-3 t/100000) C[1]}}

In[900]:=

(* s[0] = 0 => c = - 20,000,000 *)

s[t_] := 20000000 (1 - Exp[-3 t/100000]);

In[902]:=

Plot[s[t],{t,0,200000},
     PlotStyle->Red];

[Graphics:HTMLFiles/7.4_modeling_37.gif]

The  quantity of salt approaches the limiting value of 2 * 10^7 after about 100000 minutes.


Created by Mathematica  (April 25, 2004)