Iterating Rational Functions

functions = {
Function[x, x^2 -1.3],
Function[x, x^2 -1],
Function[x,x^2-0.75], 
Function[x, x^2 -0.5], 
Function[x, x^2 -0.25], 
Function[x, x^2 -0.1],
Function[x, 4.5x(1-x)],
Function[x, (x^3 +x^2 -x-1)/(1+x^2)^2], 
Function[x, 4x/(1+x^2)^3], 
Function[x, 3x/(1+x^2)^3], 
Function[x, 2/3(x+1/x^2)],
Function[x, x^3 +x^2 -1],
Function[x, 0.5x^3 -x^2 +0.5],
Function[x, (x^4-2x^3 - 3x^2 +5x -1)/(1-x+x^2)^2],
Function[x, (0.5x^5 -x^4-2x^3 - 3x^2 +5x -1)/(1-x+x^2)^2]
};

iterationSequence[x0_, f_, iterations_, showIterations_] := 
Module[
{
iterationStep,
xn1, 
lines, 
firstPoint,
showIterations2
}, 
{
iterationStep[xn_]:={xn1=f[xn];{xn, xn1}, {xn1, xn1}};
lines =Map[iterationStep, NestWhileList[f, x0, Abs[#]<(10^10) &, 1, iterations]];
firstPoint = {{x0,0.0}};
lines =Join[firstPoint, Flatten[lines, 1]];
showIterations2 =If[showIterations > Length[lines]/2-2, Length[lines]/2-2, showIterations];
If[iterations > 0,
Take[lines, -((showIterations2+2)*2 )],
{{0,0}}]
}
];

Manipulate[
If[x0<-10^range/2,x0=-10^range/2];
If[x0> +10^range/2,x0= + 10^range/2];
If[iterations < iterationsToShow, iterationsToShow = iterations];
f =functions[[functionChoice]];
realFixedPoints = Select[N[x/.Solve[f[x]== x, x]], Head[#] == Real &];
gradientOfFixedPoints = f'[realFixedPoints];
Show[
ListLinePlot[
	iterationSequence[x0, f, iterations, iterationsToShow], 
	PlotStyle-> {Orange} ,
	Epilog-> {PointSize[Medium], Point[{{x0, 0.0}}]},
	PlotRange-> {
	{-10^range/2, 10^range/2}, 
	{-10^range/2, 10^range/2}}
],
Plot[
{
If[showFx,f[x], {}],
If[showFfx,f[f[x]],{}],
If[showX, x, {}]
},
{x, -10^range/2, + 10^range/2}
],
ListPlot[Map[({#, f[#]}) &, realFixedPoints], PlotStyle-> Red, PlotMarkers-> {Automatic, 8} ],
AspectRatio-> 1/1,
PlotLabel -> Grid[{Join[{"fixed point"}, realFixedPoints], Join[{"derivative at fixed point"}, gradientOfFixedPoints]}],
ImageSize-> {380, 380},
Axes->showAxes,ImagePadding->25
],
{{x0, 0.0, "initial iteration\nvalue"},  -10^range/2, + 10^range/2, (10^range)/1000,Appearance->"Labeled",ControlPlacement->Top},
{{range, 0.75, "zoom"}, -1.0, 2.0, 0.01,Appearance->"Labeled",ImageSize->Tiny},
{{iterations, 10, "iterations to\ncompute"}, 5, 1000, 1,Appearance->"Labeled",ImageSize->Tiny},
{{iterationsToShow, 10, "iterations to\ndisplay"}, 5, iterations, 1,Appearance->"Labeled",ImageSize->Tiny},
{{functionChoice, 1, "f(x) ="},Table[ n-> TraditionalForm[Row[{functions[[n]][x]}]], {n, 1, Length[functions]}],FieldSize -> {15, 1.8}, ControlPlacement-> Top},
{{showFx, True,"f(x)"}, {True, False}},
{{showX, True,"y = x"}, {True, False}},
{{showFfx, False, "f(f(x))"}, {False, True}},
{{showAxes,True, "axes"}, {True, False}},
SaveDefinitions-> True,
AutorunSequencing ->{1},TrackedSymbols->True,ControlPlacement->Left
]

This Demonstration allows you to explore the effect of iterating a selection of polynomial and rational functions, showing three types of fixed points, f(x)=x:

1. attracting: |f' ((Subscript[x, a]))|<1. Iterations of nearby values converge to attracting fixed points.

2. repelling:|f' ((Subscript[x, r]))|>1. Iterations of nearby values are repelled.

3. indifferent:|f' ((Subscript[x, i]))|=1. The iteration behavior is difficult to predict.

Experiment with different initial values and numbers of iterations. Some iterations settle down into p-cycles that you can see by setting "iterations to display" to a smaller value than the number of iterations computed.

Contributed by: Philip Lee