Cayley's Sextic

Author

Eric W. Weisstein
June 6, 2014

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

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

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

Equations

cayleys1=4Cos[t/3]^3{Cos[t],Sin[t]};
cayleys2=4{Cos[t/2]^4(2Cos[t]-1),Cos[t/2]^3 Sin[3t/2]};

Radius

FullSimplify[Norm[cayleys1],0<t<2π]

FullSimplify[Norm[cayleys2],0<t<3π]

Cartesian

curve

Factor/@GroebnerBasis[Append[Thread[{x,y}==TrigExpand[curve]],Cos[t/3]^2+Sin[t/3]^2==1],{x,y},{Cos[t/3],Sin[t/3]},MonomialOrder->EliminationOrder]

eqn=-(a^3) (x^3)-15 (a^2) (x^4)-48 a (x^5)+64 (x^6)-42 (a^2) (x^2) (y^2)-96 a (x^3) (y^2)+192 (x^4) (y^2)-27 (a^2) (y^4)-48 a x (y^4)+192 (x^2) (y^4)+64 (y^6);

FullSimplify[%]

-(a^3) (x^3)-48 a x ((((x^2)+(y^2)))^2)+64 ((((x^2)+(y^2)))^3)-3 (a^2) ((x^2)+(y^2)) (5 (x^2)+9 (y^2))/.Thread[{x,y}->{a ((Cos[(t/3)])^3) Cos[t],a ((Cos[(t/3)])^3) Sin[t]}]//FullSimplify

Cartesian, 2nd param

eqns={x,y}-cayleys2

eqns2=TrigExpand[TrigReduce[eqns]]

Expand[Subtract@@Eliminate[And@@Join[{Sin[t]^2+Cos[t]^2==1},Thread[eqns2==0]],{Sin[t],Cos[t]}]]

soln=Factor[GroebnerBasis[Flatten[{eqns2,Cos[t]^2+Sin[t]^2-1}],{},{Cos[t],Sin[t]},MonomialOrder->EliminationOrder]][[1]]

Simplify[soln /. Thread[{x,y}-> cayleys2]]

Simplify[Subtract@@{soln,4(x^2+y^2-a x)^3-27 a^2(x^2+y^2)^2/.a->1}]

Plot

Polar

PolarPlot[Cos[t/3]^3,{t,0,3Pi},Ticks->None,PlotStyle->Red]

Parametric 1

ParametricPlot[cayleys1,{t,0,3π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]

ParametricPlot[cayleys1,{t,π,2π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]

Parametric 2

ParametricPlot[cayleys1,{t,0,3π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]

t/.Solve[Cos[t/2]^3 Sin[3t/2]==0,t]

ParametricPlot[cayleys2,{t,0,π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]

ParametricPlot[cayleys2,{t,0,2π/3},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]

ParametricPlot[cayleys2,{t,2π/3,π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]

Polar

PolarPlot[Cos[q/3]^3,{q,0,# π}]&/@Range[3]

Properties

curve=4a Cos[t/3]^3{Cos[t],Sin[t]};

ParametricPlot[Cos[t/3]^3{Cos[t],Sin[t]},{t,0,#π},ImageSize->Small]&/@Range[3]

Loop Area

par1

{ParametricPlot[cayleys1,{t,π,3π/2},PlotStyle->Red,Ticks->None,AspectRatio->Automatic],ParametricPlot[cayleys1,{t,3π/2,2π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]}

2Area[cayleys1,{t,π,3π/2}]

N[%,10]

par2

{ParametricPlot[cayleys2,{t,2π/3,π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic],ParametricPlot[cayleys2,{t,π,4π/3},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]}

2Area[cayleys2,{t,2π/3,π}]

Outer Boundary Area

curve

FullSimplify[2Area[curve,{t,0,π}]]

N[%]

par1

{ParametricPlot[cayleys1,{t,0,π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic],ParametricPlot[cayleys1,{t,2π,3π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]}

2Area[cayleys1,{t,0,π}]

N[%,10]

par2

{ParametricPlot[cayleys2,{t,0,2π/3},PlotStyle->Red,Ticks->None,AspectRatio->Automatic],ParametricPlot[cayleys2,{t,4π/3,2π},PlotStyle->Red,Ticks->None,AspectRatio->Automatic]}

2Area[cayleys2,{t,0,2π/3}]

Area

Area[curve,{t,0,3π}]

AreaInertiaTensor

AreaInertiaTensor[curve,{t,0,3π}]

Arc Length

Simplify[ArcLength[curve,{t,0,3π}],a>0]

ArcLength[cayleys1,{t,0,3π}]

ArcLength[cayleys2,{t,0,2π}]

2ArcLength[cayleys2,{t,0,π}]

ArcLength[4Cos[θ/3]^3,{θ,0,3π}]

Arc Length Function

V5

FullSimplify[ArcLength[cayleys1,t],t∈Reals]

FullSimplify[ArcLength[cayleys1,t],-3π/2<t<3π/2]

FullSimplify[ArcLength[cayleys2,t],t∈Reals]

FullSimplify[ArcLength[cayleys2,t],-π<t<π]

V6.1

ArcLength[curve,t,Assumptions->a>0&&0<t<3π]

Plot[(2 t+3 Sin[((2 t)/3)]),{t,0,3π}]

Centroid

Centroid[curve,{t,0,3π}]

Curvature

V5

FullSimplify[Curvature[cayleys1,t],0<t<3π]

FullSimplify[Curvature[cayleys2,t],0<t<2π]

Simplify[Subtract@@{(2/(3+3 Cos[t])),(1/3) ((Sec[(t/2)])^2)}]

V6.1

FullSimplify[Curvature[curve,t],a>0&&0<t<3π]

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

ByteCount/@%

Polar

FullSimplify[Curvature[a Cos[q/3]^3,q],a>0&&0<q<3π]

Inflection Point

eqn=-a^3 x^3-48 a x (x^2+y^2)^2+64 (x^2+y^2)^3-3 a^2 (x^2+y^2) (5 x^2+9 y^2);

InflectionPoints[eqn,{x,y}]//Union

Singular Point

SingularPoints[eqn,{x,y}]//Union

Slope

Slope[a Cos[t/3]^3 {Cos[t],Sin[t]},t]//FullSimplify

Slope[-a^3 x^3-48 a x (x^2+y^2)^2+64 (x^2+y^2)^3-3 a^2 (x^2+y^2) (5 x^2+9 y^2)==0,{x,y}]//FullSimplify

SpecialAffineCurvature

curve=a Cos[t/3]^3 {Cos[t],Sin[t]};

FullSimplify[SpecialAffineCurvature[curve,t],a>0&&0<t<3π]

Tangential Angle

V5

TangentialAngle[cayleys1,t,Assumptions->0<t<2π]

TangentialAngle[cayleys2,t,Assumptions->0<t<3π]

V6.1

TangentialAngle[curve,t]

Vector Properties

parm=a Cos[t/3]^3 {Cos[t],Sin[t]};
assum=a>0&&0<t<3π;
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