Bufferfly Catastrophe

Author

Eric W. Weisstein
June 27, 2013

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneCurves/ButterflyCatastrophe.nb.

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

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

Definition

eqn[a_][t_]:={8a t^3+24t^5,-6a t^2-15t^4}

Equation

{xy}=Factor/@GroebnerBasis[Thread[{x,y}==eqn[a][t]],{x,y},t]

eqn=13824 (a^5) (x^2)+84375 (x^4)-86400 (a^3) (x^2) y+144000 a (x^2) (y^2)+4096 (a^4) (y^3)-24576 (a^2) (y^4)+36864 (y^5);

Polar

Solve[Tan[θ]==1/Divide@@eqn[a][t],t]//FullSimplify

soln={{t->(1/24) Cot[θ] (-5+(25-64 a ((Tan[θ])^2))/(((-125-1248 a ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[a ((Tan[θ])^2) (3+8 a ((Tan[θ])^2)) (1125+256 a ((Tan[θ])^2))])))^(1/3))+(((-125-1248 a ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[a ((Tan[θ])^2) (3+8 a ((Tan[θ])^2)) (1125+256 a ((Tan[θ])^2))])))^(1/3)))},{t->(1/432) Cot[θ] (-90+((9+9 I (Sqrt[3])) (-25+64 a ((Tan[θ])^2)))/(((-125-1248 a ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[a ((Tan[θ])^2) (3+8 a ((Tan[θ])^2)) (1125+256 a ((Tan[θ])^2))])))^(1/3))+9 I (I+(Sqrt[3])) (((-125-1248 a ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[a ((Tan[θ])^2) (3+8 a ((Tan[θ])^2)) (1125+256 a ((Tan[θ])^2))])))^(1/3)))},{t->(1/432) Cot[θ] (-90+((9-9 I (Sqrt[3])) (-25+64 a ((Tan[θ])^2)))/(((-125-1248 a ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[a ((Tan[θ])^2) (3+8 a ((Tan[θ])^2)) (1125+256 a ((Tan[θ])^2))])))^(1/3))-9 (1+I (Sqrt[3])) (((-125-1248 a ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[a ((Tan[θ])^2) (3+8 a ((Tan[θ])^2)) (1125+256 a ((Tan[θ])^2))])))^(1/3)))}};

Sqrt[#.#]&[eqn[a][t]]

Flatten[soln][[2]]

r=(Sqrt[(((-6 a (t^2)-15 (t^4)))^2)+(((8 a (t^3)+24 (t^5)))^2)])/.Flatten[soln][[1]]/.a->1

r=√((((-(1/96) ((Cot[θ])^2) (((-5+(25-64 ((Tan[θ])^2))/(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))+(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))))^2)-(1/110592)5 ((Cot[θ])^4) (((-5+(25-64 ((Tan[θ])^2))/(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))+(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))))^4)))^2)+((((1/1728)((Cot[θ])^3) (((-5+(25-64 ((Tan[θ])^2))/(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))+(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))))^3)+(1/331776)((Cot[θ])^5) (((-5+(25-64 ((Tan[θ])^2))/(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))+(((-125-1248 ((Tan[θ])^2)+8 (Sqrt[2]) (Sqrt[((Tan[θ])^2) (3+8 ((Tan[θ])^2)) (1125+256 ((Tan[θ])^2))])))^(1/3))))^5)))^2));

FullSimplify[r,0<θ<2π]

{PolarPlot[r,{θ,0,π}],PolarPlot[r,{θ,π,2π}]}

Contour

Block[{a=1},ContourPlot[eqn==0,{x,-2,2},{y,-2,2},AxesStyle->LightGray,Axes->True,Epilog->{Point[{0,a^2/3}]}]]

Plot

V5

With[{a=.5},
ParametricPlot[{8a t^3+24t^5,-6a t^2-15t^4},{t,-.5,.5},PlotRange->{{-.05,.05},{-.25,.05}},Ticks->None,PlotStyle->Red]
]

V6

With[{a=.5},
ParametricPlot[{8a t^3+24t^5,-6a t^2-15t^4},{t,-.5,.5},Ticks->None,PlotStyle->Red,AspectRatio->Automatic,ImageSize->Small]
]

Properties

curve={8a t^3+24t^5,-6a t^2-15t^4};

Arc Length

ArcLength[eqn[a][t],{t,-∞,∞}]

Arc Length Function

FullSimplify[ArcLength[eqn[a][t],t,Assumptions->a>0&&t>0],t>0]

Curvature

FullSimplify[Curvature[eqn[a][t],t],a>0&&t>0]

SortBy[FullSimplify[Curvature[eqn,{x,y}],a>0&&(x|y)∈Reals],ByteCount]

ByteCount/@%

Inflection Points

Solve[eqn==2+30 (x^3) (x-(y^2))==0,{x,y}]

InflectionPoints[eqn,{x,y}]

Singular Points

eqn/.{x->0,y->a^2/3}

Select[SingularPoints[eqn,{x,y}],FreeQ[#,_Complex]&]

Slope

Slope[{8 a t^3+24 t^5,-6 a t^2-15 t^4},t]//FullSimplify

Slope[13824 a^5 x^2+84375 x^4-86400 a^3 x^2 y+144000 a x^2 y^2+4096 a^4 y^3-24576 a^2 y^4+36864 y^5==0,{x,y}]//FullSimplify

Slope[13824 a^5 x^2+84375 x^4-86400 a^3 x^2 y+144000 a x^2 y^2+4096 a^4 y^3-24576 a^2 y^4+36864 y^5==0,{x,y}]//FullSimplify

SpecialAffineCurvature

FullSimplify[SpecialAffineCurvature[curve,t],a>0&&t∈Reals]

Tangential Angle

FullSimplify[TangentialAngle[eqn[a][t],t],a>0&&t>0]

Vector Properties

parm={8 a t^3+24 t^5,-6 a t^2-15 t^4};
assum=(a|t)∈Reals;
xform=Abs[x_]^(n_/;Mod[n,2]==0):>x^n;

VectorLength

Assuming[assum,FullSimplify[Norm[parm]]]/.xform

NormalVector

Assuming[assum,FullSimplify[NormalVector[parm,t]]]/.xform

TangentVector

Assuming[assum,FullSimplify[TangentVector[parm,t]]]/.xform