Sine Map

Here we consist a map which is similar to the logistic map, but the mathematical function is different. Rather than f(x) = 4 λ x (1 - x) we take

f(x) = λ sin (π x)

Clear["Global`*"]

f[x_] := λ Sin[Pi x]

We plot the function for λ = 1.

Plot[{f[x]/.λ->1,x},{x,0,1}]

We find the value of the fixed point at non - zero x for this value of λ:

fp = x /. FindRoot[x ==  (f[x] /. λ -> 1), {x, 0.7}]

This fixed point is unstable since

f'[fp] /. λ -> 1

i.e. the magnitude of the derivative is greater than 1.

As for the logistic map we will be interested in the range 0 < x < 1, and 0 < λ < 1.We will find that the values of λ where period doubling occurs, (Subscript[λ, k]), will be different from those of the logistic map, but the Feigenbaum constant defined by

δ = (lim_(k -> ∞ ))(Subscript[δ, k])= (lim_(k -> ∞ ))(((Subscript[λ, k])- (Subscript[λ, k-1]))/((Subscript[λ, k+1])- (Subscript[λ, k])))

will be the same. This provides evidence that the Feigenbaum constant is  universal, i.e. the same for all maps (with a quadratic maximum). (Universality of the Feigenbaum constant can be proved mathematically using ideas from statistical mechanics called the renormalization group.)

We find where the fixed point at the origin becomes unstable.

rt0 = FindRoot[{x == f[x] , f'[x] == 1}, {x, 0}, {λ,0.3}]

l[0] = λ /. rt0

As is easy to show analytically, the solutions is λ = 1/π. The above result is indeed the numerical value of 1/π:

N[1/Pi]

Then we find where the fixed point at non-zero x becomes unstable.

rt1 = FindRoot[{x == f[x] , f'[x] == -1}, {x, 0.6}, {λ,0.7}]

l[1] = λ /. rt1

Next we compute the twice iterated function f2 and see where the fixed point of this (which is also a period - 2 limit cycle of f) becomes unstable :

f2[x_] = f[f[x]];

rt2 = FindRoot[{x == f2[x] , f2'[x] == -1}, {x, 0.8}, {λ,0.83}]

l[2] = λ /. rt2

Repeat for the fourth iterated function f4,

f4[x_] = f2[f2[x]];

rt3= FindRoot[{x == f4[x] , f4'[x] == -1}, {x, 0.85}, {λ,0.88}]

l[3] = λ /. rt3

the eight iterated function f8,

f8[x_] = f4[f4[x]];

rt4= FindRoot[{x == f8[x] , f8'[x] == -1}, {x, 0.87}, {λ,0.89}]

l[4] = λ /. rt4

the sixteenth iterated function f16,

f16[x_] = f8[f8[x]];

rt5= FindRoot[{x == f16[x] , f16'[x] == -1}, {x, 0.86}, {λ,0.866}]

l[5] = λ /. rt5

We now print the list of the (Subscript[λ, k])for k = 0, 1, ... , 5.

Table[l[i], {i, 0, 5}]

and estimate the Fiegenbaum constant

Print [ k, "       ", (Subscript[δ, k])]; 
Do[ Print[n , "      ", ( l[n] - l[n-1])/(l[n+1] - l[n])], {n, 1, 4}]

The Feigenbaum constant seems to go to a value of about 4.66 (which is correct).

Logistic Map

For comparison we give the corresponding results for the logistic map. The (Subscript[λ, k]) for k = 0, 1, ... 6 are

Clear[l]

l[0] = 0.25; l[1] = 0.75; l[2] = 0.862372;

l[3]=0.886023; l[4] = 0.891102; l[5] = 0.89219; l[6] = 0.892423;

which are different from the values for the sine map. However,  successive estimates of the Feigenbaum constants are

Print [ k, "       ", (Subscript[δ, k])]; 
Do[ Print[n , "      ", ( l[n] - l[n-1])/(l[n+1] - l[n])], {n, 1, 5}]

which tend towards about 4.669, consistent with the estimate from the sine map of about 4.66. Hence we have provided numerical evidence that the Feigenbaum constants for the logistic map and the sine map are equal, implying the  universality of the Feigenbaum constant.  More accurate calculations give δ = 4.6692... .

Finally I give more accurate values for (Subscript[λ, k]) from http://en.wikipedia.org/wiki/Feigenbaum_constants

l[0] = 1/4; l[1] = 3/4; l[2] = 0.8623724; l[3] = 0.886022575; l[4] = 0.891101825; l[5] = 0.89218985; l[6] = 0.8924229; l[7] = 0.8924728125;

This gives the following successive estimates for the Feigenbaum constant :

Print [ k, "       ", (Subscript[δ, k])]; 
Do[ Print[n , "      ", ( l[n] - l[n-1])/(l[n+1] - l[n])], {n, 2, 6}]

To nine decimal places the value is δ = 4.669201609.