Cobweb Plot

Jon Joseph

unread,

Mar 1, 2001, 4:05:32 AM3/1/01

to

I have been experimenting with chaotic systems and have been trying to
produce a "Cobweb Plot". A description of this type of plot, taken from
"CHAOS An Introduction to Dynamical Systems" by Alligood, Sauer, Yorke, is

"A cobweb plot illustrates convergence to an attracting fixed point of
g(x)=2x(1-x). Let x0=0.1 be the initial condition. Then the first iterate is
x1=g(x0)=0.18. Note that the point (x0,x1) lies on the function graph, and
(x1,x1) lies on the diagonal line. Connect these points with a horizontal
dotted line to make a path. Then find x2=g(x1)=0.2952, and continue the
path with a vertical dotted line to (x1, x2) and with a horizontal dotted
line to (x2, x2). An entire orbit can be mapped out this way."

I can create the data in a procedural program and then plot the list that
results. Can anyone think of a more elegant, Mathematica oriented,
approach? Thanks in advance

Dr. Jon Joseph
VP of Advanced Technology
Nicolet Biomedical
5225 Verona Road
Madison WI 53711
jjo...@nicoletbiomedical.com

Allan Hayes

unread,

Mar 3, 2001, 3:46:28 AM3/3/01

to

Jon,
Here is a first attempt: the key is the function NestList the rest is mostly
manipulating this to get the points and then displaying.

CobwebPlot[expr_,x_,a_,n_]:=
Block[{(f,nl, pts, min,max)},
f= Function[x,expr];
nl = NestList[f,a,n];
pts=Transpose[{Drop[#,-1],Rest[#]}&@Flatten[Transpose[{#,#}&@nl]]];
min= Min[nl];
max= Max[nl];
Plot[f[x],{x, min,max},
Epilog -> {
{Hue[0],Line[pts]}, {Hue[.7],Line[{{min,min},{max,max}}]}},
PlotRange->{min,max},
Frame->True
]
]

Test
CobwebPlot[2x (1-x),x, 0.15, 30]

--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
h...@haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565

"Jon Joseph" <pok...@tds.net> wrote in message
news:97l3cs$j...@smc.vnet.net...

Brian Higgins

unread,

Mar 3, 2001, 4:15:38 AM3/3/01

to

Jon,

There is a nice discussion about how to do this is Theo Gray and Jerry
Glynn's book on Exploring Mathematics with Mathematica. Here is a
variation on their method for 1-D maps:

g[x_] := x + 3 - Exp[.6 x]

GraphIterate[x0_, y_, n_] :=
Module[{iterate},
iterate =
Map[{Line[{{#, #}, {#, y[#]}}], Line[{{#, y[#]}, {y[#], y[#]}}]}
&,
NestList[y, x0, n]]]

Plot[g[x], {x, 0, 6}, AxesOrigin -> {0, 0}, PlotRange -> {{0, 6}, {0,
4}},
Epilog -> {Line[{{0, 0}, {8, 8}}], GraphIterate[2.6, g, 10]}]

Cheers,

Brian

Jens-Peer Kuska

unread,

Mar 6, 2001, 12:49:58 AM3/6/01

to

Hi,

something like this ?

http://www.mathconsult.ch/showroom/pubs/MathProg/htmls/p2-1.htm

Buy the book by Romand Maeder

http://www.amazon.com/exec/obidos/ASIN/0124649920/mathconsdrrmder/107-1760968-0378115

Regards
Jens

Allan Hayes

unread,

Mar 7, 2001, 6:38:48 PM3/7/01

to

Correction to my earlier posting.

Please remove parentheses from
Block[{(f,nl, pts, min,max)}

to get

Block[{f,nl, pts, min,max}

Thanks to Reza Malek-Madani for pointing our this slip up.

--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
h...@haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565

"Allan Hayes" <h...@haystack.demon.co.uk> wrote in message
news:97qb14$n...@smc.vnet.net...