(Debug) In[]:=
kp=1kn=1δ=1ap=-1an=-1imax=5
(Debug) Out[]=
1
(Debug) Out[]=
1
(Debug) Out[]=
1
(Debug) Out[]=
-1
(Debug) Out[]=
-1
(Debug) Out[]=
5
(Debug) In[]:=
multiTaylor[f_,{vars_?VectorQ,pt_?VectorQ,n_Integer?NonNegative}]:=SumNest(vars-pt).#&,Df,vars,k./.Thread[varspt],k.k.!,k.,0,n,Method"Procedural"
(Debug) In[]:=
(Debug) In[]:=
Subfamily 8
Subfamily 8
(Debug) In[]:=
Xpsub[x_,y_]=1+3x+y+x^2;Ypsub[x_,y_]=-x-2xy+x^2-3y;Xnsub[x_,y_]=-1+2x^2-x;Ynsub[x_,y_]=-x+x^2+y;
Perturbed
Perturbed
(Debug) In[]:=
Xp[x_,y_]=Xpsub[x,y]+Λ[1]x;Yp[x_,y_]=Ypsub[x,y];Xn[x_,y_]=Xnsub[x,y];Yn[x_,y_]=Ynsub[x,y];
(Debug) In[]:=
Canonic
Canonic
(Debug) In[]:=
ffp=Factor[(Yp[x,0]+xXp[x,0])/(x^2Xp[x,0])];ffn=Factor[(-Yn[x,0]+xXn[x,0])/(x^2Xn[x,0])];ggp=Factor[(Xp[xt,0]Yp[xt,yt]-Xp[xt,yt]Yp[xt,0])/(ytXp[xt,yt]Xp[xt,0])];ggn=(-Xn[xt,0]Yn[xt,yt]+Xn[xt,yt]Yn[xt,0])/(ytXn[xt,yt]Xn[xt,0]);
(Debug) In[]:=
V=Table[Λ[i],{i,1,8}]
(Debug) Out[]=
{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]}
(Debug) In[]:=
V0=Table[V[[i]]0,{i,1,8}]
(Debug) Out[]=
{Λ[1]0,Λ[2]0,Λ[3]0,Λ[4]0,Λ[5]0,Λ[6]0,Λ[7]0,Λ[8]0}
(Debug) In[]:=
fp0[x_]=Expand[Normal[Series[(ffp/.V0)+(D[ffp,{V}]/.V0).V+(D[ffp,{V,2}]/.V0).V.V/2,{x,0,imax-1}]]];fn0[x_]=Expand[Normal[Series[(ffn/.V0)+(D[ffn,{V}]/.V0).V+(D[ffn,{V,2}]/.V0).V.V/2,{x,0,imax-1}]]];
(Debug) In[]:=
gp0[x_,y_]=Sum[Expand[(D[Factor[(ggp/.V0)],{t,i}]/i!/.t->0)+(D[Factor[(D[ggp,{V}]/.V0).V],{t,i}]/i!/.t->0)+(D[Factor[(D[ggp,{V,2}]/.V0).V.V/2],{t,i}]/i!/.t->0)],{i,0,imax-1}];
(Debug) In[]:=
gn0[x_,y_]=Sum[Expand[(D[Factor[(ggn/.V0)],{t,i}]/i!/.t->0)+(D[Factor[(D[ggn,{V}]/.V0).V],{t,i}]/i!/.t->0)+(D[Factor[(D[ggn,{V,2}]/.V0).V.V/2],{t,i}]/i!/.t->0)],{i,0,imax-1}];
(Debug) In[]:=
fp[x_]=fp0[x];gp[x_,y_]=gp0[x,y];fn[x_]=fn0[x];gn[x_,y_]=gn0[x,y];
Functions y+
Functions y+
(Debug) In[]:=
yp0[1,x_]=multiTaylor[apx^(2kp-1)+x^(2kp)fp[x],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}];
(Debug) In[]:=
yp0[i_,x_]:=multiTaylor[δ^(i-1)(ap(2kp-1)!/(2kp-i)!x^(2kp-i)+Sum[Binomial[i-1,l](2kp)!/(2kp-l)!x^(2kp-l)D[fp[x],{x,i-1-l}],{l,0,i-1}])+Sum[Sum[jBinomial[i-1,l]δ^(i-l-1)BellY[l,j,Yp[l-j+1,x]](D[D[gp[x,y],{y,j-1}],{x,i-1-l}]/.y0),{j,1,l}],{l,1,i-1}],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}]
(Debug) In[]:=
yp1[i_,x_]:=multiTaylor[δ^(i-1)(Binomial[i-1,2kp](2kp)!D[fp[x],{x,i-1-2kp}]+Sum[Binomial[i-1,l](2kp)!/(2kp-l)!x^(2kp-l)D[fp[x],{x,i-1-l}],{l,0,2kp-1}])+Sum[Sum[jBinomial[i-1,l]δ^(i-l-1)BellY[l,j,Yp[l-j+1,x]](D[D[gp[x,y],{y,j-1}],{x,i-1-l}]/.y0),{j,1,l}],{l,1,i-1}],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}]
(Debug) In[]:=
Yp[1,x_]={yp0[1,x]};For[i=2,i≤2kp,i++,Yp[i,x_]=Join[Yp[i-1,x],{yp0[i,x]}];]For[i=2kp+1,i≤2kp+imax,i++,Yp[i,x_]=Join[Yp[i-1,x],{yp1[i,x]}];Print[i];]
(Debug) In[]:=
For[i=1,i≤imax,i++,yp[i,x_]=Yp[2kp+imax,x][[i]]]
Functions y-
Functions y-
(Debug) In[]:=
yn0[1,x_]=multiTaylor[anx^(2kn-1)+x^(2kn)fn[x],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}];
(Debug) In[]:=
yn0[i_,x_]:=multiTaylor[(-δ)^(i-1)(an(2kn-1)!/(2kn-i)!x^(2kn-i)+Sum[Binomial[i-1,l](2kn)!/(2kn-l)!x^(2kn-l)D[fn[x],{x,i-1-l}],{l,0,i-1}])+Sum[Sum[jBinomial[i-1,l](-δ)^(i-1-l)BellY[l,j,Yn[l-j+1,x]](D[D[gn[x,y],{y,j-1}],{x,i-1-l}]/.y0),{j,1,l}],{l,1,i-1}],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}]
(Debug) In[]:=
yn1[i_,x_]:=multiTaylor[(-δ)^(i-1)(Binomial[i-1,2kn](2kn)!D[fn[x],{x,i-1-2kn}]+Sum[Binomial[i-1,l](2kn)!/(2kn-l)!x^(2kn-l)D[fn[x],{x,i-1-l}],{l,0,2kn-1}])+Sum[Sum[jBinomial[i-1,l](-δ)^(i-1-l)BellY[l,j,Yn[l-j+1,x]](D[D[gn[x,y],{y,j-1}],{x,i-1-l}]/.y0),{j,1,l}],{l,1,i-1}],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}]
(Debug) In[]:=
Yn[1,x_]={yn0[1,x]};For[i=2,i≤2kn,i++,Yn[i,x_]=Join[Yn[i-1,x],{yn0[i,x]}];]For[i=2kn+1,i≤2kn+imax,i++,Yn[i,x_]=Join[Yn[i-1,x],{yn1[i,x]}];Print[i];]
(Debug) In[]:=
For[i=1,i≤imax,i++,yn[i,x_]=Yn[2kn+imax,x][[i]]]
Coeficients μ + and μ -
Coeficients μ + and μ -
(Debug) In[]:=
μp[n_]:=Expand[1/n!Sum[(-δ)^jBinomial[n,j]D[yp[j,x],{x,n-j}]/.x0,{j,1,n}]]
(Debug) In[]:=
μn[n_]:=Expand[1/n!Sum[δ^jBinomial[n,j]D[yn[j,x],{x,n-j}]/.x0,{j,1,n}]]
Lyapunov
Lyapunov
(Debug) In[]:=
αp[1]=-1;Ap[1]={αp[1]};For[n=2,n≤imax,n++,αp[n]=multiTaylor[Factor[(μp[2kp](2kp)!/(n+2kp-1)!BellY[n+2kp-1,2kp,Join[Ap[n-1],{0}]]+Sum[μp[i]i!/(n+2kp-1)!BellY[n+2kp-1,i,Ap[n+2kp-i]],{i,2kp+1,n+2kp-1}]-μp[n+2kp-1])/(2kpμp[2kp])],{{Λ[1],Λ[2],Λ[3],Λ[4],Λ[5],Λ[6],Λ[7],Λ[8]},{0,0,0,0,0,0,0,0},1}];Ap[n]=Join[Ap[n-1],{n!αp[n]}];Print[n];]