漸化式とグラフ&カオス

§1.漸化式とグラフ

Manipulate[
logistic[x_]:=a x(1-x);
tent[x_]=1-2Abs[x-0.5];
verneuil[x_]=2x-Floor[2 x];
g[x_]=Nest[f,x,n];
orbit=NestList[f,x0,100];
lines=Flatten[Table[{{orbit[[i]],orbit[[i+1]]},{orbit[[i+1]],orbit[[i+1]]}},{i,1,100}],1]//Prepend[{x0,0}];
contents=If[nth,{f[x],x,g[x]},{f[x],x}];
Show[Plot[contents,{x,0,1},PlotRange->{0,1},PlotStyle->{{},{},Dashed},AspectRatio->Automatic],Graphics[{Arrowheads[.03],Arrow[Take[lines,step]]}]]
,{f,{logistic->"ax(1-x)",tent,verneuil}},{a,0.5,4},{step,1,100,1},{x0,0.1,1},{{nth,False,"n次合成関数の表示"},{True,False}},{n,{2,3,4,5}},TrackedSymbols:>{f,a,step,x0,n,nth}]

§2.分岐ダイヤグラム

[f(x)=ax(1-x)の時，aが変わると極限値の値が変わる．(Subscript[x, 1])=0.3のとき，(Subscript[x, 10001])(Subscript[～x, 10101])の値をy軸にプロット]

ClearAll[f,pts];
f[a_,x_]:=a x(1-x);(*ロジスティック写像*)
 pts=Table[{a,#}&/@ NestList[f[a,#]&,Nest[f[a, #]&,0.3,10000],100],{a,0.1,4,0.001}]//Quiet;
ListPlot[pts,PlotStyle->{{Blue,PointSize[0.0001]}},AxesLabel->{a,lim (Subscript[x, n])}]//Quiet

§3.リアプノフ指数λ

λ<0のとき収束あるいは周期解．λ＞0のときカオス，λ＝0のとき分岐点

f[a_,x_]:=a x(1-x);
df[a_,x_]:=Evaluate[Log[Abs[D[f[a,x],x]]]];
lambda[a_]:=(orbit=NestList[f[a,#]&,0.3,1000];(*初期値は0.3で計算．n=1000*)
Total[df[a,#]&/@orbit]/1000)
Plot[lambda[a],{a,0,4},AxesLabel->{a,λ}]//Quiet