Bifurcation

Author

Eric W. Weisstein
January 28, 2011

This notebook downloaded from http://mathworld.wolfram.com/notebooks/DynamicalSystems/Bifurcation.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Bifurcation.html.

©2010 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Bifurcation plot for trigs idea from
Michael Trott
The Mathematica GuideBook for Programming.
New York: Springer-Verlag, 2004.
http://www.mathematicaguidebooks.org/

Initialization

<<Utilities`Plot`

Dynamical Systems

Feigenbaum=Compile[{{μ,_Real}},({μ,#}&)/@Union[Drop[NestList[μ # (1-#)&,.2,300],100]]];

f=Table[Feigenbaum[μ],{μ,3.44,3.58,.00005}];//Timing

V5

ListPlot[Flatten[f,1],
PlotStyle->{Red,AbsolutePointSize[.001]},Frame->True,
FrameLabel->TraditionalForm/@{r,x},
Axes->False,PlotLabel->TraditionalForm[HoldForm[(Subscript[x, n])=r (Subscript[x, n-1])(1-(Subscript[x, n-1]))]],
Prolog->{{Blue,Line[{{#,0},{#,1}}]&/@{3.44949,3.544090,3.564407,3.56875,3.56969,3.56989,3.569934,3.569943,3.5699451,3.569945557,3.569945672}}}
]

V6

ListPlot[Flatten[f,1],
PlotStyle->{Red,AbsolutePointSize[.001]},Frame->True,
FrameLabel->{r,x},
Axes->False,PlotLabel->HoldForm[(Subscript[x, n])==r (Subscript[x, n-1])(1-(Subscript[x, n-1]))],
Prolog->{{Blue,Line[{{#,0},{#,1}}]&/@{3.44949,3.544090,3.564407,3.56875,3.56969,3.56989,3.569934,3.569943,3.5699451,3.569945557,3.569945672}}}
]

Branches of a Function

<<Utilities`Plot`
<<Utilities`Typesetting`

Plot3D[Re[Sqrt[x+I y]],{x,-3,3},{y,-3,3},Mesh->False,PlotPoints->100,AxesLabel->TraditionalForm/@{x,y,""},PlotLabel->TraditionalForm[Re[Sqrt[z]]]
]

Bifurcation Types

Flip Bifurcation

Feigenbaum=Compile[{{mu,_Real}},({mu,#}&) /@
			Union[Drop[NestList[mu- # (1+#)&,.2,300],100]]];

mm=Flatten[Table[Feigenbaum[mu],{mu,0.,1.2,.005}],1];

ListPlot[mm,
	PlotStyle->AbsolutePointSize[.001],Frame->True,
FrameStyle->GrayLevel[.5],Axes->False,
PlotRange->{-2.5,1.8}]

Fold Bifurcation

Feigenbaum=Compile[{{mu,_Real}},({mu,#}&) /@
			Union[Drop[NestList[mu+ # (1+#)&,.2,300],100]]];

mm=Flatten[Table[Feigenbaum[mu],{mu,0.,.1,.005}],1];

ListPlot[mm,
	PlotStyle->AbsolutePointSize[.001],Frame->True,
FrameStyle->GrayLevel[.5],Axes->False]

Feigenbaum=Compile[{{mu,_Real}},({mu,#}&) /@
			Union[Drop[NestList[mu+#- #^2&,.2,300],100]]];

mm=Flatten[Table[Feigenbaum[mu],{mu,0.,2.,.005}],1];

ListPlot[mm,
	PlotStyle->AbsolutePointSize[.001],Frame->True,
FrameStyle->GrayLevel[.5],Axes->False]

Pitchfork Bifurcation

Feigenbaum=Compile[{{mu,_Real}},({mu,#}&) /@
			Union[Drop[NestList[mu #- #^3+#&,.2,300],100]]];

mm=Flatten[Table[Feigenbaum[mu],{mu,0.,2.,.005}],1];

ListPlot[mm,
	PlotStyle->AbsolutePointSize[.001],Frame->True,
FrameStyle->GrayLevel[.5],Axes->False]

Transcritical Bifurcation

Feigenbaum=Compile[{{mu,_Real}},({mu,#}&) /@
			Union[Drop[NestList[mu #- #^2+#&,.2,300],100]]];

mm=Flatten[Table[Feigenbaum[mu],{mu,0.,3.,.005}],1];

ListPlot[mm,
	PlotStyle->AbsolutePointSize[.001],Frame->True,
FrameStyle->GrayLevel[.5],Axes->False]

Trigs

Show[GraphicsArray[
Partition[
Block[{$DisplayFunction=Identity},BifurcationPlot[#[x],{x,.1},{500,200},{1,1.1,10^-3}]&/@{Cos,Cot,Csc,Sec,Sin,Tan}
],3]
],ImageSize->500]

Show[GraphicsArray[
Partition[
Block[{$DisplayFunction=Identity},BifurcationPlot[#[x],{x,.1},{500,200},{0,1.1,10^-3}]&/@{Cosh,Coth,Csch,Sech,Sinh,Tanh}
],3]
],ImageSize->500]