1 Dimensional Flows
for
dx = f[x] dt

by
K. D.  Stroyan
University of Iowa

copyright 1997 by Academic Press, Inc. - All rights reserved.

Special Mathematica Functions used in this NoteBook

Off[General::spell];
Off[General::spell1];
Off[InterpolatingFunction::dmval];
Off[ParametricPlot::pptr];
Off[Graphics::gprim];
Off[Graphics::gptn];
Off[NDSolve::ndsz];

Needs["Graphics`Colors`"]
	
colorQ[a_]:=(Head[a]===RGBColor);
grayQ[a_]:=(Head[a]===GrayLevel);
thickQ[a_]:=(Head[a]===Thickness);
absthickQ[a_]:=(Head[a]===AbsoluteThickness);
notruleQ[u_] := !(Head[u]===Rule);
ruleQ[u_] := (Head[u]===Rule);

Norm::usage = "Norm[expr] returns the Euclidean length of the
		vector, 'expr'.";
Norm[a_?VectorQ] := Sqrt[a.a];

tol = .5*10^-6;

Vector2D[tail_,tip_,opts___]:=
	Module[{ntail,ntip,sopts,Punit,up,arrow},
	ntail = N[tail];
	ntip = N[tip];
	
	sopts = Join[Select[{opts},colorQ],Select[{opts},
				thickQ],Select[{opts},absthickQ],Select[{opts},grayQ]];

If[Chop[ntail.ntail+ntip.ntip,tol] == 0,
			(*too small to plot or not number*)
			Return[Graphics[Point[{0,0}]]];
	,						
If[Chop[(ntip-ntail).(ntip-ntail),tol] == 0,
		Return[Graphics[{Join[sopts,{Line[{ntail,ntip}]}]}]];
	,
	Punit = (.15 Norm[ntip-ntail]/Norm[ntip-ntail]) (ntip-ntail) ;
	up =  {-Punit[[2]],Punit[[1]]};
	arrow = Line[{ntail,ntip,ntip-Punit+up,ntip,ntip-Punit-up}];
	]];
Return[Graphics[{Join[{AbsoluteThickness[2]},Join[sopts,{arrow}]]}]];
];

		
uArrow[vec_,opts___]:= 
	Module[{a,b},
		If[Norm[N[vec]]<1,b = vec,b=vec/Norm[vec]];
				a=ToExpression["Tail"]/.Select[{opts},ruleQ]/.
					{ToExpression["Tail"]->{0,0}};
				Return[Vector2D[a,a+b,opts]]
				];
				
vectorFlow1D[f_,{y_,t_},initVals_,tFinal_,dt_,opns___] :=
 Module[{soln,arr,pt,pt0,ptt,seg,crv,tt,x},
soln =Flatten[Map[
	NDSolve[{x[0]==0,y[0]==#,
	x'[t] == 1,y'[t] == f[y[t]]},
	{x[t],y[t]},{t,0,tFinal}]&,
										initVals],1];
											
pt[tt_] := Map[Graphics[{Blue,AbsolutePointSize[5],Point[{tFinal,#}]}]&,
y[t]/.soln/.t->tt];

pt0[tt_] := Map[Graphics[{Blue,AbsolutePointSize[5],Point[{0,#}]}]&,
y[t]/.soln/.t->tt];

ptt[tt_] := Map[Graphics[{Blue,AbsolutePointSize[4],Point[{#[[1]],#[[2]]}]}]&,
{x[t],y[t]}/.soln/.t->tt];

seg[tt_] := Map[Graphics[{Green,Line[{{#[[1]],#[[2]]},{tFinal,#[[2]]}}]}]&,
{x[t],y[t]}/.soln/.t->tt];

	arr[tt_] := Map[uArrow[{0,f[#]},Tail->{tFinal,#},Red]&,
	y[t]/.soln/.t->tt];
										
crv[tt_] := Plot[Evaluate[y[t]/.soln],{t,0,tt},opns,
			AspectRatio->1,DisplayFunction->Identity];
			
Show[{crv[dt/100],pt[0],pt0[0],seg[0],arr[0]},opns,
PlotRange->{{0,10},{0,10}},AspectRatio->1,
DisplayFunction->$DisplayFunction];
Do[Show[{crv[tt],pt[tt],ptt[tt],seg[tt],arr[tt]},DisplayFunction->$DisplayFunction];,
{tt,dt,tFinal,dt}];
	Return[soln];	
];

flow1D[f_,{y_,t_},initVals_,tFinal_,dt_,opns___] :=
 Module[{soln,ptt,pt,pt0,seg,crv,tt,x},
soln =Flatten[Map[
	NDSolve[{x[0]==0,y[0]==#,
	x'[t] == 1,y'[t] == f[y[t]]},
	{x[t],y[t]},{t,0,tFinal}]&,
										initVals],1];
											
pt[tt_] := Map[Graphics[{Blue,AbsolutePointSize[5],Point[{tFinal,#}]}]&,
y[t]/.soln/.t->tt];

pt0[tt_] := Map[Graphics[{Blue,AbsolutePointSize[5],Point[{0,#}]}]&,
y[t]/.soln/.t->tt];

ptt[tt_] := Map[Graphics[{Blue,AbsolutePointSize[4],Point[{#[[1]],#[[2]]}]}]&,
{x[t],y[t]}/.soln/.t->tt];

seg[tt_] := Map[Graphics[{Green,Line[{{#[[1]],#[[2]]},{tFinal,#[[2]]}}]}]&,
{x[t],y[t]}/.soln/.t->tt];
;
										
crv[tt_] := Plot[Evaluate[y[t]/.soln],{t,0,tt},opns,
			AspectRatio->1,DisplayFunction->Identity];
			
Show[{crv[dt/100],pt[0],pt0[0],seg[0]},opns,
PlotRange->{{0,10},{0,10}},AspectRatio->1,
DisplayFunction->$DisplayFunction];
Do[Show[{crv[tt],pt[tt],ptt[tt],seg[tt]},DisplayFunction->$DisplayFunction];,
{tt,dt,tFinal,dt}];
	Return[soln];	
];

BeginPackage["Graphics`flow1D`"];
flow1D::usage =
"vectorFlow1D[f,{y,t},initVals,tFinal,dt,opns___]
	shows the flow solution of dx = f[y] dt,
	starting with the initial (y)-value = initialValues = {a,b,c,d,...}
	flowing up to time tFinal with animation frames every dt time units.";
put in package???
Begin["`Private`"];
End[];
EndPackage[];

Notebook Overview

This NoteBook shows the "flow" of various initial conditions moving under the "growth law" a differential equation.  The "flow" just takes place on the "y axis," but the solution is also plotted vs t on the "x axis" to help you see the points moving.

References to the Text

Section 21.1

In section 21.1 we study one dimensional continuous initial value problems.  This notebook will help in observing how x changes with respect to t and how this varies depending on where the quantity x starts at.

Definition 21.1

Definition 21.1 states that the mathematical form of a one dimensional initial value problem at starting time t0 is:

WHERE WE START:  x[t0]=a
	for some constant a

HOW WE CHANGE:  (dx/dt) = f[t, x]
	for a known function of two variables, f[.,.]

Flow1D[.] Examples

The general logistic growth equation is

dx = r x (1 - x/c) dt

for positive constants  r  and  c.  The constant  r  is the intrinsic fertility rate and  c  is the carrying capacity.  <Enter> the next computation to see the flow on the vertical axis for various initial values associated with this equation.

Clear[t, x, f]; f[x_] := 0.5 x (1 - (x/2)); initXs = Table[x, {x, 0, 4, 1}]; tFinal = 10; dt = 1; \(soln = 
      vectorFlow1D[f, {x, t}, initXs, tFinal, dt, 
        PlotRange -> {{0, tFinal + dt}, {0, 4}}]; 

    xSoln[t_] = x[t] /. soln\)

The vectorFlow1D[.] function defined in the Initialization cell above returns the solution functions as "Interpolating functions."  These can be plotted and evaluated numerically as follows:

Plot[Evaluate[xSoln[t]], {t, 0, tFinal}];

xSoln[0]\(	xSoln[2]\)xSoln[10]

The Logistic-like S-I-S Equation and the Endemic Limit (Problem 21.5)

The S-I-S epidemic model can be expressed as a logistic-like equation

ds = b(1-s)(1- c s) dt

The following computation shows the flow line of this equation without direction vectors.

Clear[t, s, f]; f[s_] := b (1 - s) (1 - c s); b = (1/5.) ; c = (10/3.) ; initSs = Table[x, {x, 0, 1.05,  .05}]; tFinal = 5; dt = 0.25; flow1D[f, {s, t}, initSs, tFinal, dt, 
      PlotRange -> {{0, tFinal + dt}, {0, 1.2}}];

Exercises

Exercise 21.2.4 & 5  Attraction, Repulsion & Indecision

(1)  Plot the vectorFlow1D[.] of the differential equation

dx = ((x^2)/10) dt

for a variety of initial conditions on both sides of the equilibrium point, (Subscript[x, E]) = 0, say x from  -2 to 2 in steps of 0.5, say for 0 < t < 4.  (Remember that positive solutions of this equation grow VERY fast.)

What kind of equilibrium is (Subscript[x, E]) = 0?  (Attracting, repelling, neither?)

(2)  Plot the vectorFlow1D[.] of the differential equation

dx = Sin[x] dt

for a variety of initial conditions on both sides of several equilibrium points, (Subscript[x, E]) = 0, (Subscript[x, E]) = Pi, (Subscript[x, E]) = 2Pi, ...

What kind of equilibria are (Subscript[x, E]) = -Pi, 0, Pi, 2Pi, ...?  (Attracting, repelling, neither?)

Exercise 21.2.6  Logistic Growth

Use flow1D[.]  to solve the logistic growth equation

dx = x (1 - (x/3457.6)) dt

for a variety of initial conditions, espeially above and below 3457.6