Tools for Analyzing Discrete Dynamical Systems:
Graphical Analysis
Written by Richard A. Holmgren
last modified July 20, 1996

These programs were developed for use with the text  A First Course in Discrete Dynamical Systems, 2nd edition by Richard A. Holmgren, which was published by Springer-Verlag in 1996.    Suggestions for improvement are gratefully accepted.  Please contact Professor Holmgren at rholmgre@alleg.edu with suggestions and comments.

Graphical Analysis with One Intial Point

The following code will do graphical analysis of the function f(x) = 3.5x(1-x) starting at the point determined by startingValue.  firstIt and lastIt are the first and last iterations plotted, and xmin and xmax are the bounds used on the domain and range in the plot.

Clear[f,firstIt,lastIt,xmin,xmax,dataTable,i,y];
f[x_] := 3.5x (1-x)

startingValue = .1;

firstIt = 0;
lastIt = 5;

xmin =	0;
xmax =  1;

	(*  Finding the Points  *)

i = 0;
y = N[startingValue];

While[i < firstIt, y = f[y]; i++];

dataTable = {{y,y},{y,f[y]}};

While[i < lastIt,
	y = f[y];
	AppendTo[dataTable,{y,y}];
	AppendTo[dataTable,{y,f[y]}];
	i++];
	
AppendTo[dataTable,{f[y],f[y]}];

	(*  Drawing the Cobweb  *)


Clear[cobweb];
cobweb = ListPlot[dataTable,
	PlotJoined -> True,
	PlotRange -> {{xmin,xmax},{xmin,xmax}},
	AspectRatio -> 1,
	PlotStyle->GrayLevel[.3],
	DisplayFunction -> Identity];
	
	(*  Drawing the graphs of h and y=x  *)
	
Clear[graph];
graph = Plot[{f[t],t},{t,xmin,xmax},
	PlotRange -> {xmin,xmax},
	AspectRatio -> 1,
	DisplayFunction -> Identity];

	(*  Displaying the result  *)


Show[cobweb,graph,DisplayFunction -> $DisplayFunction]

Graphical Analysis with One Initial Point -- Points Added

This  program is identical to the previous one except that points are added where the cobweb intersects the graph or the line y=x.  Points on the line y=x represent points in the orbit of the starting value.

Clear[f,firstIt,lastIt,xmin,xmax,dataTable,i,y];
f[x_] := 3.5x(1-x)

startingValue = .1	;

firstIt = 0	;
lastIt = 5	;

xmin =  0	;
xmax =  1	;

(*  computations for first seed  *)

i = 0;
y = N[startingValue];

While[i < firstIt, y = f[y]; i++];

dataTable = {{y,y},{y,f[y]}};

Clear[pts];
pts = {Point[{y,y}],Point[{y,f[y]}]};

While[i < lastIt,
	y = f[y];
	AppendTo[dataTable,{y,y}];
	AppendTo[dataTable,{y,f[y]}];
	AppendTo[pts,Point[{y,y}]];
	AppendTo[pts,Point[{y,f[y]}]];
	i++];

AppendTo[dataTable,{f[y],f[y]}];
AppendTo[pts,Point[{f[y],f[y]}]];

Clear[cobweb];
cobweb = ListPlot[dataTable,PlotJoined -> True,
	PlotRange -> {{xmin,xmax},{xmin,xmax}},
	AspectRatio -> 1,
	PlotStyle->GrayLevel[.3],
	DisplayFunction -> Identity];
	
Clear[showpts];
showpts = Graphics[{PointSize[.015],pts}];


	(*  computations for graph   *)
	
Clear[graph];
graph = Plot[{f[t],t},{t,xmin,xmax},
	PlotRange -> {xmin,xmax},
	AspectRatio -> 1,
	DisplayFunction -> Identity];



Show[cobweb,
		graph,showpts,
		DisplayFunction -> $DisplayFunction]

Graphical Analysis with Three Initial Points

This program does graphical analysis with three initial points denoted x0, x1, and x2.

Clear[f,firstIt,lastIt,xmin,xmax,i,y];
f[x_] := 3.7x(1-x)

x0 = .1	;
x1 = .2	;
x2 = .3	;

firstIt = 0;
lastIt = 5;

xmin =  0;
xmax =  1;

(*  computations for first seed  *)

i = 0;
y = N[x0];

While[i < firstIt, y = f[y]; i++];

Clear[dataTable0];
dataTable0 = {{y,y},{y,f[y]}};

Clear[pts0];
pts0 = {Point[{y,y}],Point[{y,f[y]}]};

While[i < lastIt,
	y = f[y];
	AppendTo[dataTable0,{y,y}];
	AppendTo[dataTable0,{y,f[y]}];
	AppendTo[pts0,Point[{y,y}]];
	AppendTo[pts0,Point[{y,f[y]}]];
	i++];
	
AppendTo[dataTable0,{f[y],f[y]}];
AppendTo[pts0,Point[{f[y],f[y]}]];

cobweb0 = ListPlot[dataTable0,PlotJoined -> True,
	PlotRange -> {{xmin,xmax},{xmin,xmax}},
	AspectRatio -> 1,
	PlotStyle->GrayLevel[.1],
	DisplayFunction -> Identity];
	
Clear[showpts0];
showpts0 = Graphics[{PointSize[.013],pts0}];

	
(*  computations for second seed  *)

i = 0;
y = N[x1];

While[i < firstIt, y = f[y]; i++];

Clear[dataTable1];
dataTable1 = {{y,y},{y,f[y]}};

Clear[pts1];
pts1 = {Point[{y,y}],Point[{y,f[y]}]};

While[i < lastIt,
	y = f[y];
	AppendTo[dataTable1,{y,y}];
	AppendTo[dataTable1,{y,f[y]}];
	AppendTo[pts1,Point[{y,y}]];
	AppendTo[pts1,Point[{y,f[y]}]];
	i++];

AppendTo[dataTable1,{f[y],f[y]}];
AppendTo[pts1,Point[{f[y],f[y]}]];

cobweb1 = ListPlot[dataTable1,PlotJoined -> True,
	PlotRange -> {{xmin,xmax},{xmin,xmax}},
	AspectRatio -> 1,
	PlotStyle->GrayLevel[.3],
	DisplayFunction -> Identity];
	
Clear[showpts1];
showpts1 = Graphics[{PointSize[.013],pts1}];


	(*  computations for third seed  *)

i = 0;
y = N[x2];

While[i < firstIt, y = f[y]; i++];

Clear[dataTable2];
dataTable2 = {{y,y},{y,f[y]}};

Clear[pts2];
pts2 = {Point[{y,y}],Point[{y,f[y]}]};

While[i < lastIt,
	y = f[y];
	AppendTo[dataTable2,{y,y}];
	AppendTo[dataTable2,{y,f[y]}];
	AppendTo[pts2,Point[{y,y}]];
	AppendTo[pts2,Point[{y,f[y]}]];
	i++];

AppendTo[dataTable2,{f[y],f[y]}];
AppendTo[pts2,Point[{f[y],f[y]}]];

cobweb2 = ListPlot[dataTable2,PlotJoined -> True,
	PlotRange -> {{xmin,xmax},{xmin,xmax}},
	AspectRatio -> 1,
	PlotStyle->GrayLevel[.5],
	DisplayFunction -> Identity];

Clear[showpts2];
showpts2 = Graphics[{PointSize[.013],pts2}];


	(*  computations for graph   *)
	
Clear[graph];
graph = Plot[{f[t],t},{t,xmin,xmax},
	PlotRange -> {xmin,xmax},
	AspectRatio -> 1,
	DisplayFunction -> Identity];



Show[cobweb0,cobweb1,cobweb2,
		graph,showpts0,showpts1,showpts2,
		DisplayFunction -> $DisplayFunction]