THESE FIRST FEW CELLS (WHICH LOOK EMPTY) CONTAIN THE CODE FOR THE COMMANDS USED BELOW.  I WOULDN'T RECOMMEND DELETING THEM.  YOU ARE WELCOME TO TAKE A LOOK THOUGH!

cobwebs[functmm_,lowermm_,endmm_,startmm_,nummm_,opts___]:=(makesomelines[x_]:={Line[{{x,x},{x,functmm[x]}}],Line[{{x,functmm[x]},{functmm[x],functmm[x]}}]};Plot[{x,functmm[x]},{x,lowermm,endmm},opts,Epilog->{makesomelines/@NestList[functmm,startmm,nummm]}])

orbitwebs[functmm_,lowermm_,endmm_,startmm_,nummm_,skipmm_,opts___]:=Plot[{x,functmm[x]},{x,lowermm,endmm},opts,Epilog->{Line[Partition[NestList[functmm,Nest[functmm,startmm,skipmm],nummm],2,1]]}]

cyclefinder[functmm_,startmm_,maxmm_]:=Block[
	{nthmm,twonthmm,countermm,resultmm,valuemm},
	nthmm=functmm[startmm];
	twonthmm=functmm[functmm[startmm]];
	countermm=1;
	While[(Abs[nthmm-twonthmm]>10^(-11)) &&
		(countermm<maxmm),
		nthmm=functmm[nthmm];
		twonthmm=Nest[functmm,twonthmm,2];
		++countermm];
	resultmm={nthmm};
	valuemm=functmm[nthmm];
	If[Abs[countermm-maxmm]>.5,
		While[Abs[valuemm-nthmm]>10^(-10),
			AppendTo[resultmm,valuemm];
			valuemm=functmm[valuemm];]];
	Print["The counter stopped at: ",countermm];
	If[maxmm>countermm,
		Print["There seems to be a cycle of length:  ",Length[resultmm]],
		Print["No cycle found"]];
	outlist=resultmm;
	If[Abs[countermm-maxmm]>.5,resultmm,nthmm]]

silentfinder[functmm_,startmm_,maxmm_]:=Block[
	{nthmm,twonthmm,countermm,resultmm,valuemm},
	nthmm=functmm[startmm];
	twonthmm=functmm[functmm[startmm]];
	countermm=1;
	While[(Abs[nthmm-twonthmm]>10^(-11)) &&
		(countermm<maxmm),
		nthmm=functmm[nthmm];
		twonthmm=Nest[functmm,twonthmm,2];
		++countermm];
	resultmm={nthmm};
	valuemm=functmm[nthmm];
	If[Abs[countermm-maxmm]>.5,
		While[Abs[valuemm-nthmm]>10^(-10),
			AppendTo[resultmm,valuemm];
			valuemm=functmm[valuemm];]];
	(*Print["The counter stopped at: ",countermm];
	If[maxmm>countermm,
		Print["There seems to be a cycle of length:  ",Length[resultmm]],
		Print["No cycle found"]];*)
	outlist=resultmm;
	]

iterategraph[functmm_, startmm_, numbermm_, skipmm_, opts___]:=
 ListPlot[NestList[functmm,Nest[functmm,startmm,skipmm],numbermm]
 , opts]

iterate[functmm_,startmm_, itmm_,skipmm_]:= 
MatrixForm[N[NestList[functmm,Nest[functmm,N[startmm],skipmm],itmm],10]]

iterateexact[functmm_,startmm_, itmm_,skipmm_]:= 
MatrixForm[NestList[functmm,Nest[functmm,startmm,skipmm],itmm]]

symbols[list_]:=Table[If[list[[i]]<.5,0,1],{i,1,Length[list]}]

newtons[functionmm_, varmm_, startmm_, itmm_] :=
(newt[zmm_] :=  zmm - (functionmm /. varmm-> zmm)/(D[functionmm,varmm] /. varmm->zmm);
iterate[newt,startmm, itmm, 0])

newtonsexact[functionmm_, varmm_, startmm_, itmm_] :=
(newt[zmm_] :=  zmm - (functionmm /. varmm-> zmm)/(D[functionmm,varmm] /. varmm->zmm);
iterateexact[newt,startmm, itmm, 0])

All of these functions will be used at some point in the course.

f[x_] := a x(1-x);  (*Section 5.1*)

g[x_] := x E^(r (1-x));

h[x_] := x^2+c;

j[x_] := Abs[x-1];

circle[x_] := Mod[n x, 1];  (*Section 5.1*)

power[x_] :=  x^n;  (*Section 5.1 for n=2*)

tent[x_] := If[x<1/2, c x, -c (x-1)];  (*  Section 5.1:  Note step function here! *)

lc[z_] := c z;

(*Here is a bigger step function.  See the end of the file for analysis.*)
step[x_] := 3 /; x<1;
step[x_] := 2x+1 /; 1<= x <= 2;
step[x_] := 7-x /; 2<= x <= 3;
step[x_] := 10-2x /; 3<= x <= 4;
step[x_] := 6-x /; 4<= x <= 5;
step[x_] := 1 /; x>5;

newf[x_] := k(1-(Abs[2x-1])^p)

A fixed point for a function f(x) is a number p such that f(p)=p.  One way to find fixed points is to graph the function, together with the line y=x.  The fixed points are the points of intersection.

a=5; eps=.5;
Plot[{f[x],x, 1}, {x,-eps,1+eps}, PlotRange->All]

You can also solve the equation f(x)=x, or use FindRoot if the Solve command can't handle it.

a=7/2;
Solve[f[x]==x,x]

c=2;
Plot[{tent[x],x}, {x,0,1}, PlotRange->All]

c=2;
Solve[tent[x]==x,x]

n=3;
Plot[{circle[x],x}, {x,0,1}, PlotRange->All]

n=2;
Solve[circle[x]==x,x]

Solve[Mod[2 x,1]==x,x]

A periodic point of period n is a point p satisfying (f^n)(p)=p, and the point is said to be of least period n if (f^k)(p)p for all 0<k<n. The methods described above can also work for points of higher period.  I have included an example of a search for period 3 points.

a=5;
Plot[{Nest[f,x,3],f[x],x}, {x,0,1}, PlotRange->{0,1}]

a=5;
Solve[Nest[f,x,2]==x,x]

Here are more searches for period 3 points.

c=2;
Plot[{Nest[tent,x,3],tent[x],x}, {x,0,1}]

n=2;
Plot[{Nest[circle,x,3], circle[x], x}, {x,0,1}]

FindRoot[Nest[circle,x,3]==x,{x,.15}]

I have included syntax and examples of each command available.  To apply any command to a function not predefined in this code, define your function then put the name of your function in the command.

iterate[function, starting value, number of iterates to print, number to skip before printing]

a=5;
iterate[f,.123,10,30]

If you want to iterate the function (e^x)-5, which is not predefined, define it the proceed as outlined.  The commands below define the function, then iterate it 5 times, starting with x=.5 and showing all output.

myfunction[x_]:=Cos[x]

iterate[myfunction,3, 10, 0]

Sometime we want to iterate exact values.  Don't use this command unless you know that's what you want to do.

n=2;
iterateexact[circle,3/9,10,0]

Why not use iterateexact all the time?  Note that if we left the input as 0.5 Mathematica would use decimal approximations.

iterateexact[myfunction,1/2, 5, 0]

Here is an example of how to iterate a complex number in polar form.  Notice that I'm using the polar form to make sure I use a point on the circle |z|=1.  If you're off by even a tiny bit, the iterates will wander away from the circle.

theta=2 Pi 7/11; n=2;
iterateexact[power,E^(I theta), 12,0]

The next few commands are only for real functions where graphing in the plane makes sense.

This shows the iterates of a function as a graph.  The iterate number is on the horizontal, and the function value is on the vertical.

a=3.5;
iterategraph[f, .4, 100, 0, PlotJoined->False]

Cobwebs[ function, lower limit, upper limit, starting value, number of iterates]

a=3.5;
cobwebs[f,0,1,.75,10]

orbitwebs[function, lower limit, upper limit, starting value, number of iterates, number of iterates to skip before plotting]

a=3.5;
orbitwebs[f,0,1,.734,100,20,AspectRatio->Automatic]

Be wary of the next command - there are tolerances involved which can cause this command to give false results.  It must be used with caution, but used with other commands, can be very helpful.  It finds an attracting cycle if one exists.

cyclefinder[function, starting point, number of iterates to try]

Solve[h[x]==x,x]

FullSimplify[Abs[h'[(1/10) (5.-(Sqrt[25-63 I]))]]]

c=63/100 I;
cyclefinder[h,0,5000]

Abs[h'[-0.18109857147211067`+0.46248812314258747` I]]

r=2.69;
cyclefinder[g,.5,500]

cyclefinder[cuberoot,.5,500]

n=2;
cyclefinder[circle,1/25,500]

Don't worry about this one yet.

n=2;
iterate[circle,.4,10,0]

symbols[%]

The lesson for Section 5.1.

f1[x_] := E^x-2

Plot[{f1[x],x}, {x,-3,2}]

Solve[f1[x]==1. x,x]

f1'[x] /. % (*Where % is the last output.  You could also refer to a specific output, or ty[e your own list of insertions using arrows.*)

f[x_] := x^2

iterate[f,-0.1,5,0]

cube[x_] := - x^3;
cuberoot[x_] := - Sign[x] Abs[x]^(1/3);

(-1.)^(1/3)  (*Why do we need to do this?  Check out this output!*)

iterate[cuberoot,-.09,10,0]

Plot[{f1[x],x}, {x,-2,2}]

FindRoot[f1[x]==x,{x,2}]

n=2;
iterateexact[circle,1/3,10,0]

To iterate multiple points at the same time, use a list as input for the iterate or iterateexact command.

iterateexact[circle,{0,(1/3),(1/24)},10,0]

iterate[circle,{0.,1/3.,1/5.},10,0]

n=2;
iterateexact[power,E^(Pi/5 I),10,0 ]

The lesson for Section 5.2

Here is some code for plotting orbits.  I joined the points so you can see where the points are.  To change the function, you need to change the "lc" to the name of the function you wish to iterate.

psi = Pi/4;
rho = 1;
c=rho E^(I psi);
orblength = 20;
seed=1 E^(I 0);
orbitlist=Table[{Re[Nest[lc,seed,i]],Im[Nest[lc,seed,i]]},{i,0,orblength}];
ListPlot[orbitlist, Joined->True, AspectRatio->Automatic, PlotRange->All]

We will also use the code above to answer some questions.

c=E^(I Pi/4);
iterateexact[lc,4/10,10,0]

c=1/Sqrt[2] + I/Sqrt[2];
iterateexact[lc,4/10,10,0]

I was playing with periodic points, and knowing when 1/p generates a cycle of length p-1 for the circle function f(x)=nx.  Turns out it's a very hard number theory question!

cyclelist={};
goodlist={};
max=101;
n=2;
If[OddQ[max]==True,
Do[
silentfinder[circle,1/i,max];
AppendTo[cyclelist, outlist];
If[Length[outlist]==(i-1), AppendTo[goodlist,i]]
,{i,3,max,2}]
,Print["Not odd, c'mon - wake up!"]];
goodlist

cyclelist={};
goodlist={};
max=301;
n=8;
If[OddQ[max]==True,
Do[
silentfinder[circle,1/i,max];
AppendTo[cyclelist, outlist];
If[Length[outlist]==(i-1), AppendTo[goodlist,i]]
,{i,3,max,1}]
,Print["Not odd, not good!"]];
goodlist

An Example From Section 5.4

linfun[x_]:=em x + bee;
em = 11/12+1/10 I;
bee = 4 -2I;
seed=0;
orblength = 100;
orbitlist=Table[{Re[Nest[linfun,seed,i]],Im[Nest[linfun,seed,i]]},{i,0,orblength}];
p1=ListPlot[orbitlist, Joined->True, AspectRatio->Automatic, PlotRange->All, PlotStyle -> {PointSize[.01]}];
p2=ListPlot[orbitlist, Joined->False, AspectRatio->Automatic, PlotRange->All, PlotStyle -> {PointSize[.02], Red}];
point = zee /.Solve[linfun[zee]==zee,zee];
p3 = Graphics[{PointSize[Large],Green,Point[{Re[point][[1]],Im[point][[1]]}]}];
Show[p1,p2,p3]

Graphics[{PointSize[Large],Pink,Point[{Re[point][[1]],Im[point][[1]]}]}]

a=3.83;
iterate[f,.123,20,100]

roots=Solve[f[f[f[x]]]==x,x]

derivs=f'[x]/. roots

derivs[[2]] derivs[[4]] derivs[[8]]

derivs[[3]] derivs[[5]] derivs[[7]]

1.6523183035367754`

Section 5.5

JuliaSetPlot[0.38-0.35I]

Manipulate[JuliaSetPlot[rlm+imm I, PlotRange->{{-2,2}, {-2,2}}(*, ColorFunction->None*)], {rlm, -2, 2}, {imm, -2, 2}]

JuliaSetPlot[0.32+0.01I, PlotLegends->Automatic]

JuliaSetPlot[z^5-1,z]

JuliaSetPlot[z^5-0.6,z, ColorFunction->None]

Brief Lesson for Discrete Structures

Do you remember Newton's Method from  Calc 1?  To find a solution to f(x)=0, we iterate N(x)=x-((f(x))/(f '(x))) using a suitable starting value.

newtons[x^2-x-1,x,3,15]

You will may want to iterate some functions, and this file gives you a few commands to work with.

f1[x_] := 3.1x(1-x)

iterate[f1,.2345, 10,100]

cobwebs[f1,0,1,.2345,10]

orbitwebs[f1,0,1,.2345,10,100]

Solve[f1[f1[x]]==x,x]

Plot[step[x], {x,0,6}]

iterate[step, Sqrt[2],10,10] (*Try a rational here*)

Plot[{Nest[step,x,3],f[x],x}, {x,1,5}, PlotRange->All] (*No period 3!)

Plot[{Nest[step,x,7],f[x],x}, {x,1,5}, PlotRange->All] (*But there we have period 7 - we knew we had period 5*)