Math 215 - Solutions to selected homework problems

• Assignment 2, due Wednesday February 11, 1998

---

Assignment 2, due 2:00 Wednesday February 11, 1998:

• Behavior near the chaotic point r = 4. Experiment with the following command for various values of m.

g[r_, x_] := r*x*(1-x); G[1, r_, x_] := g[r, x];

G[n_, r_, x_] := g[r, G[n-1, r, x]];

m=6;
Do[k=10*(2m-1)^2;
   Plot[{G[n, r, .5], .5},{r, 4 - k/4^n, 4}],
   {n, m-1, m+3}]

What does this experiment suggest? Can you find a more familiar function of r which approximates G[n, r, .5] for r slightly less than 4?

Solution.

The plots produced by this code for m = 6 are indistinguishable (apart from the differences in the horizontal scale) for n > 8. This indicates that G[n, 4-e/4^n, .5] and G[n+1, 4-e/4^(n+1), .5] are very close for small e > 0. Also it seems to oscillate between 0 and 1.

Let

H[n_, e_] := 2*G[n, 4-e/4^n, .5] - 1.

Then Plot[H[10,e], {e,0,1000}] gives



Plot of H[10, e].

This looks like a cosine function, but the wavelength is varying. It helps to look at where is crosses the horizontal axis.From the picture above we can see that they occur at roughly e = 10, 80, 240, 480 and 800. We can use FindRoot to get more precise values, and they are 9.86981, 88.8424, 246.832, 484.127, and 799.979. These numbers are roughly equal to 1, 9, 25, 49 and 81 times the first value. This means that zeroes occur when Sqrt[e] is an odd multiple of the value where the first zero occurs. On the other hand, Cos[t] = 0 whenever t is an odd multiple of Pi/2. Here is a plot comparing H[10,e] (in black) and -Cos[Sqrt[e/4]] (in blue). The code is

Plot[{H[10,e],-Cos[Sqrt[e/4]]},{e,0,10000}, PlotStyle\[Rule]{RGBColor[0,0,0], RGBColor[0,0,1] } ]

If we replace H[10,e] by H[12,e], we get an even better fit.

Why should -Cos[Sqrt[e/4]] be such a good approximation for H[n,e] for large n and small positive e? Recall that

H[n_, e_] := 2*G[n, 4-e/4^n, .5] - 1

and

G[n+1, 4-e/4^n, .5]

= (4-e/4^n)*G[n, 4-e/4^n, .5]*(1-G[n, 4-e/4^n, .5]).

The latter implies that

H[n+1, 4*e] = (4 - e/4^n)*(1 - H[n, e]^2)/2 - 1,

and this is approximately

4*(1 - H[n, e]^2)/2 - 1 = 1 - 2*H[n, e]^2.

On the other hand, for any positive constant k we have

- Cos[Sqrt[4*k*e]] = - Cos[2*Sqrt[k*e]]

                   = 1 - 2*Cos[Sqrt[k*e]]^2,

which is similar to the relation

H[n+1, 4*e] = 1 - 2*H[n, e]^2.

This suggests that for large n and small e, H[n, e] is well approximated by -Cos[Sqrt[k*e]]. To find the appropriate value of k, use

Do[Print["H[",n,",e] = ",

         Normal[Series[H[n,e],{e,0,1}]]],{n,1,4}];

Normal[Series [-Cos[Sqrt[k*e]],{e,0,1}]]

and get

H[1,e] = 1. - 0.125 e

H[2,e] = -1 + 0.125 e

H[3,e] = -1 + 0.125 e

H[4,e] = -1 + 0.125 e

-1 + (e*k)/2

which implies that k = 1/4.

• Extra credit: Behavior of the criticial orbit for r = 1. Look at the curve produced by the code

f[x_] := r*x*(1-x); F[0,x_] := x; F[n_, x_] := f[F[n-1, x]];

r=1;Points = {}; Do[AppendTo[Points, {n,F[n,.5]}],{n,1,200}]; ListPlot[Points, PlotJoined -> True]

Find a rough formula for this curve, i.e., an approximation for F[n,.5] as a function of n. Give analytic and/or graphical evidence to support your assertion.

Solution.

Here is some faster code that produces the same result.

f[x_] := r*x*(1-x); y= .5; r=1; Points = {};

Do[y = f[y]; AppendTo[Points, {n, y}],{n,1,200}];

ListPlot[Points, PlotJoined -> True]

Here is the plot produced by the code in question.



Plot of F[n, .5].

This appears to look like the function 1/n. There are at least two ways to check this experimentaly.

• We can plot the difference 1/n-F[n,.5], which is shown below.



Plot of 1/n-F[n,.5].

Notice that the vertical scale is quite small, indicating a good agreement between 1/n and F[n,.5].

• We can plot the product n*F[n,.5], which is shown below.



Plot of n*F[n,.5].

Notice that this quantity is close to 1, which also indicates a good agreement between 1/n and F[n,.5].

Why should 1/n be a good approximation for F[n, .5]? Let y[n_] := F[n, .5]. Then we have

y[n+1] - y[n] = f[y[n]] - y[n]

              = - y[n]^2.

This is also the slope of the secant line connecting the points (n, y[n]) and (n+1, y[n+1]). We can regard this as an approximation for y'[n], and then use DSolve to solve the resulting differential equation. Typing

Clear[y]; DSolve[y'[x]==-y[x]^2, y[x], x]

gives

{{y[x] -> 1/(x - C[1])}}

for some constant C[1]. To find a good value for it we use

f[x_] := r*x*(1-x); y= .5; r=1; Points = {};

Do[y = f[y]; AppendTo[Points, {n, n-1/y}],{n,1,200}];

ListPlot[Points, PlotJoined -> True]

and the result is



Plot of n - 1/F[n, .5].

This page was last revised on February 15, 1998.

Return to course home page.