Strange Attractor

Author

Eric W. Weisstein
January 27, 2011

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

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

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

Initialization

<<Utilities`FilterOptions`

Code

Options[QuadraticAttractor]={
InitialPoint->{.05,.05},
MaxIterations->10^4,
DropPoints->100,
Cutoff->100.,
Frame->True,
FrameLabel->TraditionalForm/@{x,y},
PointStyle->{Red,AbsolutePointSize[.01]}
};

QuadraticAttractor[{a_,b_},opts___?OptionQ]:=Module[{
l,
z0,maxits,cutoff,drop,pstyle,
gopts=FilterOptions[Graphics,opts,Options[QuadraticAttractor]]
},
{z0,maxits,cutoff,drop,pstyle}={InitialPoint,MaxIterations,Cutoff,DropPoints,PointStyle}/.{opts}/.Options[QuadraticAttractor];
cutoff=cutoff^2;
gopts=FilterOptions[Graphics,opts,Options[QuadraticAttractor]];
l=NestWhileList[{a,b}.{1,#[[1]],#[[1]]^2,#[[1]]#[[2]],#[[2]],#[[2]]^2}&,z0,#.#<cutoff&,1,maxits];
Graphics[{Sequence@@Flatten[pstyle],
If[drop>Length[l],{},Point[Drop[l,drop]]]
},Evaluate[gopts]]
]

Sprott[s_String]:=Partition[Characters[s]/.Thread[CharacterRange["A","Y"]->Range[-1.2,1.2,.1]],6]/;StringLength[s]==12

Hénon Map

Show[QuadraticAttractor[{{1,0,-1.4,0,1,0},{0,.3,0,0,0,0}},{0,0}]]

Sprott

sprott={
"AMTMNQQXUYGA","CVQKGHQTPHTE",
"FIRCDERRPVLD","GIIETPIQRRUL",
"GLXOESFTTPSV","GXQSNSKEECTX",
"HGUHDPHNSGOH","ILIBVPKJWGRR",
"LUFBBFISGJYS","MCRBIPOPHTBN",
"MDVAIDOYHYEA","ODGQCNXODNYA",
"QFFVSLMJJGCR","UWACXDQIGKHF",
"VBWNBDELYHUL","WNCSLFLGIHGL"
};

Length[sprott]

V5

Show[GraphicsArray[Partition[QuadraticAttractor[Sprott[#],PlotLabel->#,MaxIterations->5 10^4]&/@Take[sprott,8],2,2,{1,1},{}],GraphicsSpacing->{-.08,.1}]]

Show[GraphicsArray[Partition[QuadraticAttractor[Sprott[#],PlotLabel->#,MaxIterations->5 10^4]&/@Take[sprott,-8],2,2,{1,1},{}],GraphicsSpacing->{-.08,.1}]]

V6

GraphicsGrid[Partition[QuadraticAttractor[Sprott[#],AspectRatio->1/GoldenRatio,PlotLabel->#,MaxIterations->1 10^4]&/@Take[sprott,6],3,3,{1,1},{}],Spacings->{-50,20}]