Bifurcation diagram of Logistic Map

看板Mathematica作者biglion ( )時間13年前 (2011/07/09 01:29)推噓1(1推 0噓 0→)

留言1則, 1人參與討論串1/2 (看更多)

看到你的非線性的例子讓我借題發揮一下提到非線性系統一定不會漏掉 Logistic Map 著名的 Bifurcation diagram 相信只要對非線性有些微了解的人都看過不要覺得這很難畫其實使用Mathematica 可以很輕易的就畫出來哦！ (****** Code Start *******) (* Definition of Logistic Map *) lmap[r_][xn_] := r xn (1 - xn); (* Run n iterations and pick the last m pts *) np[n_][m_][r_] := Thread[{r, Take[NestList[lmap[r], Random[], n], -m]}] (* Collect data from r=r1 to r=r2 with step dr *) s[r1_, r2_, dr_, n_, m_] := Flatten[np[n][m] /@ Range[r1, r2, dr], 1]; (* run r=2.9~4.0 step=0.0005 *) g2d9to4d0 = s[2.9, 4, .0005, 1000, 200]; (*It may take ~10 seconds*) (* See the result! *) fig1=ListPlot[g2d9to4d0, PlotRange -> {{2.9, 4}, {0, 1}}, PlotStyle -> PointSize[.0001], FrameLabel -> {"r", "xn"}, Frame -> True, RotateLabel -> False] fig2=ListPlot[g2d9to4d0, PlotRange -> {{3.4, 3.67}, {0.73, 0.92}}, PlotStyle -> PointSize[.0001], FrameLabel -> {"r", "xn"}, Frame -> True, RotateLabel -> False] (****** Code End ******) fig2其實是fig1的一部分兩張圖長得很像吧從這兩張的相似性就可以一窺 Chaos的一大特色 Code核心的部分其實只有三行其實也還可以再濃縮這就可以看出 Mathematica functional programming 的威力 ※ 引述《chungyuandye (養花種魚數月亮賞星星)》之銘言： : ※ 引述《kichigop (超痛恨不求甚解...XXX)》之銘言： : : Legend部分現學現賣用戴老師教給大家的 : : 但是顏色有點怪怪的(還請老師指教),程式部分相當拙劣,是剛學Mathematica時寫的 : : 請大家多多包涵 : : 不過重點是畫完圖我發現書上的兩條線好像應該對調 : : 這一小節主要是在講Chaos的產生與initial conditions有很大的關係(蝴蝶效應) : : 並且在這個example 4.3中利用一個noliear eqation給予不同的I.C.來驗證 : : 結果得到fig. 4-24。 : : (分隔線以下直接複製即可...我是用Mathematica 7.0版) : : =================================================================== : : (*The two plots in Marion's textbook should be exchanged!!!*) : : (* The nonlinear equation is: : : Subscript[x, n+1]=\[Alpha] Subscript[x, n](1-Subscript[x, n]^2) \ : : *) : : mylegend[plot_Graphics, legend_List] := : : Block[ : : {p = plot, l = legend, color, temp}, : : color = Cases[p, Hue[a_, b_, c_] :> Hue[a, b, c], Infinity]; : : temp = {color[[#]], l[[#]]} & /@ Range[Length@color]; : : Labeled[p, : : Grid[{Graphics[{#[[1]], Thickness[0.1], Line[{{0, 0}, {1, 0}}]}, : : ImageSize -> {24, 24}, AspectRatio -> 24/24, : : ImagePadding -> 0], #[[2]]} & /@ temp], {Top}] : : ] : : (*以上為戴老師的Legend*) : : \[Alpha] = 2.5; : : recip[x_] := \[Alpha] x (1 - x^2); : : chaos1 = NestList[recip, 0.700000000, 50];(*blue*) : : recip[x_] := \[Alpha] x (1 - x^2); : : chaos2 = NestList[recip, 0.700000001, 50];(*red*) : : p1 = ListPlot[ : : {chaos1, chaos2}, : : PlotRange -> {0, 1}, : : Joined -> True, : : PlotStyle -> {{RGBColor[0, 0, 1], : : Thickness[.003]}, {RGBColor[1, 0, 0], Thickness[.002]}}, : : BaseStyle -> {FontFamily -> "Helvetica", FontSize -> 15, : : FontWeight -> "Bold"}]; : : mylegend[p1, {"0.700000000", "0.700000001"}] : 稍微做一下修改，有些事情用動畫比較能夠讓人了解 : Chaos[inita_, initb_, iter_] := : Block[{ita = inita, itb = initb, n = iter, recip, \[Alpha]}, : \[Alpha] = 2.5; : recip[x_] := \[Alpha] x (1 - x^2); : ListLinePlot[ : Transpose@ : NestList[{recip[#[[1]]], recip[#[[2]]]} &, {ita, itb}, iter], : PlotStyle -> {{Blue, Thickness[.003]}, {Red, Thickness[.002]}}, : Frame -> True, : BaseStyle -> {FontFamily -> "Helvetica", FontSize -> 15, : FontWeight -> "Bold"}, PlotRange -> {{0, 100}, {0, 1.1}}] : ] : Manipulate[ : mylegend[Chaos[0.700000000, 0.7000000001, x], : {"0.700000000", "0.7000000001"}], : {{x, 2, "Time"}, 2, 100, 1}] -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 180.177.9.5