Finding universal limiting function g and value of α

The logistic map, simplest power expansion (single term used) of function g(x)

Clear[b,α,x,Fg,Fg2,poly,coeff,r]
r=3.56994567;
Lmap[x_]=r x (1-x);
Fg[x_]=1+b (x^2);(*approximation of limiting function g(x)*)
Fg2[x_]=Nest[1+b ((#)^2)&,Fg[x],1];(*second iterate of funcction g(x)*)

α=(1/(Fg[1]));(*Feigenbaum constant α*)
poly=Collect[α Fg2[(x/α)],x];(*neglect O(x^4) terms and proceed*)
Fg[x]
poly/.x^power_/;power>2->0 (*neglect O(x^4) terms and proceed*)
(*collect same powers of x and eliminate the x*)

(* Fg[x] == αFg2[(x/α)] *)
(* (bx^2) == 2(b^2)(1+b)(x^2), eliminate (x^2) *)
coeff=Solve[b==2 (b^2) (1+b),b] (*does not depend on x or powers of x*)(*solving for coefficient b of the quadratic expansion term x^2*)

(*select the correct value of coefficient from three solutions*)
alpha =N[α/.coeff[[2]]];
Plot[{Fg[x]/.coeff[[2]],alpha Fg2[x/alpha]/.coeff[[2]],Lmap[x+0.5],Lmap[x+0.5]+0.1},{x,-0.5,0.5},FrameLabel->{(Subscript[x, n]),(Subscript[x, x+1])},LabelStyle->20,PlotLegends->{"g(x), (one term)","((αg)^2)(x/α), (one term)","Logistic map","Logistic map shifted"},ImageSize->400,Frame->True,PlotRange->All]

(*select the correct value of coefficient from three solutions*)
Style[
StringForm["α = ``",N[α/.coeff[[2]]]],
Blue,33]

The logistic map, 4 term power expansion of function g(x)

Expanding the polynomials of g(x) iterate

Clear[a,b,c,d,e,α,x,Fg,Fg2,power,poly]
Fg[x_]=1+a (x^2)+b (x^4)+c (x^6)+d (x^8);(*approximation of limiting function g(x)*)
Fg2[x_]=Simplify[Expand[Nest[1+a ((#)^2)+b ((#)^4)+c ((#)^6)+d ((#)^8)&,Fg[x],1]]];(*second iterate of function g(x)*)

α=(1/(Fg[1]));(*Feigenbaum constant α*)
poly=Collect[α Fg2[(x/α)],x];
Fg[x]
poly/.x^power_/;power>8->0(*neglect O(x^10) terms and proceed*)
(*collect same powers of x*)

Solving for the coefficients of the power expansion

Clear[a,b,c,d]
(*ordering of powers: x^0, x^2, x^4, x^6, x^8*)
(*collect by hand, same powers of x and eliminate the x*)
(* Fg[x] == αFg2[(x/α)] *)
N[Solve[{
a==  (1/(1+a+b+c+d))(2 (a^2) (((1+a+b+c+d))^2)+4 a b (((1+a+b+c+d))^2)+6 a c (((1+a+b+c+d))^2)+8 a d (((1+a+b+c+d))^2)),
b==  (1/(1+a+b+c+d))((a^3) (((1+a+b+c+d))^4)+2 a b (((1+a+b+c+d))^4)+6 (a^2) b (((1+a+b+c+d))^4)+4 (b^2) (((1+a+b+c+d))^4)+15 (a^2) c (((1+a+b+c+d))^4)+6 b c (((1+a+b+c+d))^4)+28 (a^2) d (((1+a+b+c+d))^4)+8 b d (((1+a+b+c+d))^4)),
c== (1/(1+a+b+c+d))(2 (a^2) b (((1+a+b+c+d))^6)+4 (a^3) b (((1+a+b+c+d))^6)+12 a (b^2) (((1+a+b+c+d))^6)+2 a c (((1+a+b+c+d))^6)+20 (a^3) c (((1+a+b+c+d))^6)+4 b c (((1+a+b+c+d))^6)+30 a b c (((1+a+b+c+d))^6)+6 (c^2) (((1+a+b+c+d))^6)+56 (a^3) d (((1+a+b+c+d))^6)+56 a b d (((1+a+b+c+d))^6)+8 c d (((1+a+b+c+d))^6)),
d== (1/(1+a+b+c+d))((a^4) b (((1+a+b+c+d))^8)+a (b^2) (((1+a+b+c+d))^8)+12 (a^2) (b^2) (((1+a+b+c+d))^8)+6 (b^3) (((1+a+b+c+d))^8)+2 (a^2) c (((1+a+b+c+d))^8)+15 (a^4) c (((1+a+b+c+d))^8)+12 a b c (((1+a+b+c+d))^8)+15 (b^2) c (((1+a+b+c+d))^8)+30 a (c^2) (((1+a+b+c+d))^8)+2 a d (((1+a+b+c+d))^8)+70 (a^4) d (((1+a+b+c+d))^8)+4 b d (((1+a+b+c+d))^8)+28 (b^2) d (((1+a+b+c+d))^8)+6 c d (((1+a+b+c+d))^8)+56 a c d (((1+a+b+c+d))^8)+8 (d^2) (((1+a+b+c+d))^8)+12 (a^2) b (((1+a+b+c+d))^8) (5 c+14 d))},
{a,b,c,d},Reals]]

Calculating the value of the Feigenbaum α

Clear[a,b,c,d,α,x,Fg]
Fg[x_]=1+a (x^2)+b (x^4)+c (x^6)+d (x^8);(*approximation of limiting function g(x)*)
α=(1/(Fg[1]));(*Feigenbaum constant α*)
(*select the correct set of values of coefficients from generated solutions*)
StringForm["α = ``",
α/.{a->-1.5277896832130473`,b->0.10532905967250375`,c->0.026309139428459152`,d->-0.003343783768597341`}]

Plotting g(x) and comparing it to the logistic map

Clear[a,b,c,d,α,x,Fg,Lmap,r]
a=-1.5277896832130473`;
b=0.10532905967250375`;
c=0.026309139428459152`;
d=-0.003343783768597341`;

Fg[x_]=1+a (x^2)+b (x^4)+c (x^6)+d (x^8);(*approcimation of limiting function g(x)*)
Fg2[x_]=Simplify[Expand[Nest[1+a ((#)^2)+b ((#)^4)+c ((#)^6)+d ((#)^8)&,Fg[x],1]]];
r=3.56994567;(*R_infty value*)
Lmap[x_]=r x (1-x);(*definition of Logistic map*)

alpha=(1/(Fg[1]));
Plot[{Fg[x],alpha Fg2[x/alpha],Lmap[x+0.5],Lmap[x+0.5]+0.1},{x,-0.5,0.5},FrameLabel->{(Subscript[x, n]),(Subscript[x, x+1])},LabelStyle->20,PlotLegends->{"g(x)","((αg)^2)(x/α), (four terms)","Logistic map","Logistic map shifted"},ImageSize->400,Frame->True]

Style[StringForm["α = ``",(1/(Fg[1]))],Blue,33](*Feigenbaum constant α*)

Creation of this notebook was supported by IT Academy program of Information Technology Foundation for Education (HITSA).