Cobwebbing

Adam Rumpf, 11/4/2014

Introduction

The initialization code below defines a function called cobweb[], which accepts a pure function, a parameter r, an initial value, and a number of iterations. It then produces a cobweb plot for the given function. This is used for the main Manipulate environment at the end of the Notebook, which has a number of simple built-in discrete dynamical systems, each of which depends on a single parameter r. Note that the meaning of the parameter is different in each system.

Some of thesefunctions are arbitrary and only meant for showing off how different shapes of function can behave, but a few have some significance:

The discrete logistic map, of the general form (Subscript[x, n+1])=r (Subscript[x, n])(1-(Subscript[x, n])), is usually thought of as describing a population whose size is limited by finite resources. (Subscript[x, n]) is the population at time step n, scaled so that 1 is the holding capacity. r>0 is the intrinsic growth rate. This system is famous for exhibiting chaotic behavior when r is sufficiently large. Try increasing the value of r slowly to watch as the nonzero fixed point goes from being stable, to being surrounded by periodic orbits, to complete chaos.

The discrete logistic map with proportional harvesting has the general form (Subscript[x, n+1])=r (Subscript[x, n])(1-(Subscript[x, n]))-p (Subscript[x, n]). This is exactly the logistic growth model, but now a proportion 0<p<1 of the current population is removed each iteration.

The discrete logistic map with constant harvesting has the general form (Subscript[x, n+1])=r (Subscript[x, n])(1-(Subscript[x, n]))-h. This is similar to the proportional harvesting model, except that now a constant amount of population h>0 is removed each iteration.

The linear map simply consists of a line passing through the point ((1/2),(1/2)) with a slope variable between -1 and 1. It is meant to act as a clear demonstration of how the stability of a fixed point depends on the slope of the function curve where it intersects the y=x line.

Code

Initialization

(* generates the cobweb plot for a given pure function f, parameter r, initial value x0, and number of iterations n *)
cobweb[f_,r_,x0_,n_]:=Module[{pts={{x0,0}},y},
(* generate sequence of points *)
Do[
(* vertical to f *)
y=f[pts[[-1,1]],r];
pts=Append[pts,{pts[[-1,1]],y}];
If[y<0||y>(10^30),
(* break if we reach a negative value or too large of a value *)
Break[];
];
(* horizontal to y=x *)
pts=Append[pts,{y,y}],
{i,1,n}];
(* draw diagram *)
Show[Plot[{x,f[x,r]},{x,0,1},PlotStyle->{Directive[Thick,Black],Blue}],Graphics[{Red, Line[pts]}],PlotRange->{{0,1},{0,1}},AspectRatio->1,Axes->True,AxesLabel->{"(Subscript[x, n])","(Subscript[x, n + 1])"}]
]

Demonstration

Manipulate[Module[{},
cobweb[f,r,x0,30]
],{{f,4#2#1(1-#1)&,"(Subscript[x, n + 1])"},{4#2#1(1-#1)&->"4(Subscript[rx, n])(1-(Subscript[x, n])) - logistic map",3#1(1-#1)-#2#1&->"3(Subscript[x, n])(1-(Subscript[x, n]))-(Subscript[rx, n]) - logistic w/ prop. harvesting",2#1(1-#1)+0.5#2-0.25&->"2(Subscript[x, n])(1-(Subscript[x, n]))+0.5r-0.25 - logistic w/ const. harvesting",4(#2-0.5)(#1-0.5)+0.5&->"2(r-0.5)((Subscript[x, n])-0.5)+0.5 - linear",5.6((#1)^3)-7((#1)^2)+2.5#1+0.4#2&->"5.6((Subscript[x, n])^3)-7\!((Subscript[x, n])^2)+2.5(Subscript[x, n])+0.4r - cubic"},PopupMenu},{{r,0.65,"r"},0,1},{{x0,0.25,"(Subscript[x, 0])"},0.01,0.99}]