Re: Bifurcation diagram of Logistic Map

看板Mathematica作者chungyuandye (養花種魚數月亮賞星星)時間13年前 (2011/07/09 09:34)推噓0(0推 0噓 2→)

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

※ 引述《biglion ( )》之銘言： : 看到你的非線性的例子讓我借題發揮一下 : 提到非線性系統 : 一定不會漏掉 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 ******) 稍微用Compile修改一下 npc=Compile[{{n,_Integer},{m,_Integer},{r,_Real}}, {r,#}&/@NestList[r *# *(1-#)&,Random[],n][[-m;;-1]] ]; t[r1_,r2_,dr_,n_,m_]:=Flatten[Map[npc[n,m,#]&,Range[r1,r2,dr]],1] u[r1_, r2_, dr_, n_, m_] := Flatten[ParallelMap[npc[n, m, #] &, Range[r1, r2, dr]], 1] ex1 = AbsoluteTiming@s[2.9, 4, .0005, 1000, 200]; ex2 = AbsoluteTiming@t[2.9, 4, .0005, 1000, 200]; ex3 = AbsoluteTiming@u[2.9, 4, .0005, 1000, 200]; ex1[[1]] ex2[[1]] ex3[[1]] ListPlot[#[[2]], PlotRange -> {{2.9, 4}, {0, 1}}, PlotStyle -> PointSize[.0001], FrameLabel -> {"r", "xn"}, Frame -> True, RotateLabel -> False]&/@{ex1,ex2,ex3} 如果是8.0而且有安裝C Compiler的話，npc後面面可以加上 CompilationTarget -> "C" -- 養花種魚數月亮賞星星 http://chungyuandye.twbbs.org -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 118.232.186.105