An Informal Look At Order And Disorder

Mathematica in Education
Vol.2 No.4
(October 1993)

by
D.C.M. Burbulla and C.T.J. Dodson 
University of Toronto

This note gives two examples of order and apparent disorder,
from simple iterated functions.

Analysing Time-Series Data

Consider a simple time series generated by sine functions

s[t_] := (Sin[20 2 Pi t/256] + Sin[40 2 Pi t/256] + 
		Sin[80 2 Pi t/256]) / 3

This is evidently a sum of three sine waves with frequencies
20, 40 and 80 cycles per second.  Make a table of values of s[t]

st = Table[ N[s[n]], {n,256}];

Plotting we get

ListPlot[st, PlotJoined->True];

Now suppose that we had actually recorded this plot as data from some experiment; 
the usual technique to employ in discovering any periodicities is the Fourier Transform.
We apply this Mathematica function to our data and it gives us  a function of 
frequency which has amplitude proportional to the contribution of that frequency:

fst = ListPlot[Abs[Fourier[st]],
		PlotJoined -> True, 
		PlotRange -> All];

This correctly reveals that there were frequency components at frequencies f=20, 40 and 
80 cycles per second. (Their ghosts appear again at frequencies 256-f where f=20,40,80.
More discussion of the Fourier transform function is given in the Mathematica book.)

Nesting Functions

The function Nest can quickly generate iterations of funtions. For example,
if we  take a quadratic and an initial value , say 0.1, then we can tabulate 
the first three  iterations as follows:

p[x_] := x^2

ptab = Table[ Nest[p, 0.1, n], {n,3}]

Which correctly gives p[0.1], p[p[0.1]], p[p[p[0.1]]].

The following function

f[x_] := 1 - 2 x^2

looks simple enough. It is bounded by +1 and -1 on the interval [-1,1] 
and achieves its single maximum, 1,  at x=0; it has minima of -1 at the
endpoints of the interval and it has two fixed points, at x=-1 and  x=0.5. 
Now pick any number in the interval [-1,1]  and Nest f. For example, 
with initial value again 0.1

Table[ Nest[f, 0.1, n], {n,3}]

which has no obvious pattern. Try a few more iterations

Table[ Nest[f, 0.1, n], {n,10}]

In fact, try a large number and ListPlot them; so give the Table a name first

ftab = Table[ Nest[f, 0.1, n], {n, 256}];

plotftab = ListPlot[ftab, PlotJoined -> True];

We take the Fourier transform and plot its absolute value, as before

fpt = ListPlot[Abs[Fourier[ftab]], 
		PlotJoined -> True];

This time there is no obvious evidence of periodicity, which suggests that there
may be no order in the sequence of values. However, we know from the form of
the function f and the definition of the Nest iteration operation that there is order
present. For if we ListPlot the successive points in the iteration, each against its 
predecessor, we can see the actual structure:

ftabseq = Partition[ftab, 2];
ListPlot[ftabseq];

They fall, as is clear from the definition, on the curve defined by the function f that 
is being iterated; order in a very strict sense. Other initial values for the iteration 
give similar results.

Functional Iteration And Fixed Points

Finding a fixed point of a function g(x) is  equivalent to solving the equation
g(x) -x = 0. The Brouwer Fixed Point Theorem says that every continuous 
function from a closed n-ball to itself (in particular, from a a closed interval
to itself)  has a fixed point. Finding it is an interesting exercise in successive
approximations. The Mathematica function FixedPoint provides one method,
for example, we estimate a fixed point of the cosine function starting form an 
initial guess of 0.0.

FixedPoint[Cos, 0.0, 20]

Cos[%]

After a few more iterations the procedure homes in on the fixed point at  0.739085.

In our book Self-Tutor For Computer Calculus Using Mathematica 2, 
Prentice-Hall Canada 1992, (Japanese translation now published by Prentice-Hall Japan)  
we defined a function, fixedpoint, to illustrate graphically the progress of functional 
iteration to find a fixed point.

fixedpoint/: fixedpoint[g_, a_, {b_, c_}][n_] := 
Module[{one,two,three,four,five},
one = Module[{x, i}, 
	Plot[{g[x], x},{x, b, c},
    		AspectRatio -> Automatic, 
    		PlotRange -> {{b, c}, {b, c}},
    		DisplayFunction -> Identity]];
 
 two = Module[{i}, 
	ListPlot[Table[{Nest[g, N[a], i], 0}, {i, 0, n + 1}],
        	DisplayFunction -> Identity]]; 
 
 three = Module[{i}, 
	ListPlot[Table[{Nest[g, N[a], i], Nest[g, N[a], i]},
                    {i, 0, n + 1}], 
        	DisplayFunction -> Identity]]; 
 
 four = Module[{i}, 
	ListPlot[Table[{Nest[g, N[a], i], 
    				Nest[g, N[a], i + 1]},
           		{i, 0, n + 1}], 
        	DisplayFunction -> Identity]];
 
 five = Module[{i}, 
 	ListPlot[Table[{Nest[g, N[a], Floor[i/2]],
        Mod[i + 1, 2]*Nest[g, N[a], Floor[i/2]] +
        Mod[i, 2]*g[Nest[g, N[a], Floor[i/2]]]}, {i, 0, 2 n + 3}],
        PlotJoined -> True, 
        DisplayFunction -> Identity]];
 
 Show[one, two, three, four, five,
	PlotLabel -> 
	FontForm[If[n == 0,{"beginning fixed point iteration",
		If[a == 0, "0 = initial guess", If[a == 1,
        "1 = initial guess", a " = initial guess"]]},
   {(n + 1) "iterations completed", N[Nest[g, a, n + 1]] 
   "= approximation"}],{"Helvetica",8}], DisplayFunction -> $DisplayFunction]
 ]

fixedpoint::usage = "fixedpoint[f, a, {b, c}][n] performs (n + 1)
iterations of the Fixed Point iteration method for approximating 
solutions to the equation f[x] == x, starting with x0 = a. The output 
plots f and the identity function, y = x, on the interval {b, c}; 
shows all successive approximations x0, x1, ... , xn, x(n + 1) along 
the x-axis; indicates the value of the current approximation in the 
PlotLabel; and shows the `cobweb' of points homing in on the fixed 
point."

fixedpoint[Cos, 0.0, {0, 1}][30];

Consider next the family of parabolic functions  for k>0

g[k_][x_] := k x (1 - x)

fixedpoint[g[2.7], 0.1, {0, 1}][20];

Which homes in on the fixed point quite quickly. However, no such convergence is
obtained if  k=4, even after 100 iterations:

fixedpoint[g[4], 0.1, {0, 1}][100];

More exercises, discussion and background references can be found in Chapter 13 of 
our book.