Finding universal limiting function g and value of α

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

Clear[b,α,x,Fg,Fg2,poly,coeff,r]
r=3.56994567; (*Accumulation point R_infty value.*)
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]));(*The Feigenbaum constant α.*)
Fg[x] (*Original polynoomial.*)
poly=Collect[α Fg2[(x/α)],x](*Need to neglect O(x^4) terms and proceed.*)
poly/.x^power_/;power>2->0  (*Neglecting O(x^4) terms and proceed.*)

(*Collect same powers of x and eliminate x.*)
(* Fg[x] == αFg2[(x/α)] *)
(* (bx^2) == 2(b^2)(1+b)(x^2), Eliminate (x^2) and simplify. Result solved below.*)
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]]];

(*Ploting and shifting of the apex to graph origin.*)
Plot[{alpha Fg2[x/alpha]-1/.coeff[[2]],Fg[x]-1/.coeff[[2]],Lmap[x+0.5]-(r/4)},{x,-0.5,0.5},FrameLabel->{(Subscript[x, n]),(Subscript[x, n+1])},LabelStyle->20,PlotLegends->{"α(g^2)((x/α)), one term","g(x), one term","Logistic map"},ImageSize->400,Frame->True,PlotRange->All, PlotStyle->{{Normal, Red},{Thickness[0.01],Dashed, Blue}, {Normal}} ]

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

The logistic map, 4 term power series 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]));(*The Feigenbaum constant α*)
Fg[x]
poly=Collect[α Fg2[(x/α)],x];
poly/.x^power_/;power>8->0(*Neglecting O(x^10) terms and proceeding.*)
(*Collect same powers of x*)

Solving for the coefficients of the power series 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 x, simplify.*)
(* 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]));(*The Feigenbaum constant α*)
(*Select a 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;(*Accumulation point R_infty value.*)
Lmap[x_]=r x (1-x);(*Definition of the logistic map.*)

alpha=(1/(Fg[1]));
Plot[{alpha Fg2[x/alpha]-1,Fg[x]-1,Lmap[x+0.5]-(r/4)},{x,-0.5,0.5},FrameLabel->{(Subscript[x, n]),(Subscript[x, n+1])},LabelStyle->20,PlotLegends->{"α(g^2)((x/α)), four terms","g(x), four terms","Logistic map"},ImageSize->400,Frame->True, PlotStyle->{{Normal, Red},{Thickness[0.01],Dashed, Blue}, {Normal}}]

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).