Trefoil Curve

Author

Eric W. Weisstein
February 3, 2018

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

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

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

Equations

foliumxy=((x^2)+(y^2)) (x (b+x)+(y^2))-4 a x (y^2);

foliumxy12=ExpandAll[foliumxy/.{x->-x,a->1,b->2}]

trefoil=x^4+x^2 y^2+y^4-x(x^2-y^2)

Expand[%]

eqn=-(x^3)+(x^4)+x (y^2)+(x^2) (y^2)+(y^4);

Expand[foliumxy12-((x^4)+2(x^2) (y^2)+(y^4)-2x ((x^2)-(y^2)))]

xeqns=(y/.Solve[x^4+x^2 y^2+y^4==x(x^2-y^2),y]//FullSimplify)

Plot[xeqns,{x,-.2,1}]

yeqns=x/.Solve[x^4+x^2 y^2+y^4==x(x^2-y^2),x]

Plot[yeqns,{y,-1/(Sqrt[12]),1/(Sqrt[12])},PlotLegends->Automatic]

Bounds

Maximize[{x,x^4+x^2 y^2+y^4==x(x^2-y^2)},{x,y},Reals]//FullSimplify

Maximize[{y,x^4+x^2 y^2+y^4==x(x^2-y^2)},{x,y},Reals]//FullSimplify

Maximize[{y,x^4+x^2 y^2+y^4==x(x^2-y^2)&&x<0},{x,y},Reals]//FullSimplify

Plot

V5

<<Graphics`ImplicitPlot`

ImplicitPlot[x^4+x^2 y^2+y^4==x(x^2-y^2),{x,-3,3},Ticks->None,AspectRatio->Automatic,PlotStyle->Red]

V6

ContourPlot[x^4+x^2 y^2+y^4==x(x^2-y^2),{x,-.2,1},{y,-.3,.3},Ticks->None,AspectRatio->Automatic,ContourShading->None,ContourStyle->Red,PlotPoints->100]

Interior

V5

<<Graphics`InequalityGraphics`

InequalityPlot[x^4+x^2 y^2+y^4<x(x^2-y^2),{x},{y}]

V6

RegionPlot[x^4+x^2 y^2+y^4<x(x^2-y^2),{x,-.2,1},{y,-.3,.3},AspectRatio->Automatic,PlotPoints->100]

Properties

trefoil=x^4+x^2 y^2+y^4==a x(x^2-y^2)

Area

RegionPlot[x^4+x^2 y^2+y^4<x(x^2-y^2),{x,-.3,1},{y,-.3,.3},AspectRatio->Automatic]

NIntegrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,∞},{y,-∞,∞}]//Timing

(area=Integrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,∞},{y,-∞,∞}])//Timing

(area=Integrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{y,-∞,∞},{x,-∞,∞}])//Timing

Top of main blob

NIntegrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,0,∞},{y,0,∞}]

Integrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,0,∞},{y,0,∞}]//Timing

Integrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{y,0,∞},{x,0,∞}]//Timing

FullSimplify[ToRadicals[(-Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,3]+Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,4])],0<y<1/(2(Sqrt[3]))]

...wrong...

Plot[{
-Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,3]+Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,4],
((Sqrt[1+2 (y^2)+(Sqrt[1-12 (y^2)])])/(Sqrt[2]))},{y,0,1/(2(Sqrt[3]))}]

NIntegrate[((Sqrt[-x (1+x)+(Sqrt[(x^2)+6 (x^3)-3 (x^4)])])/(Sqrt[2])),{x,0,1}]

NIntegrate[((Sqrt[-x (1+x)+x(Sqrt[1+6 x-3 (x^2)])])/(Sqrt[2])),{x,0,1}]

FullSimplify[Subtract@@yeqns[[{4,2}]]]

NIntegrate[(1/4) (2 (Sqrt[1-12 (y^2)])-(Sqrt[2+4 (y^2)-2 (Sqrt[1-12 (y^2)])])+(Sqrt[2]) (Sqrt[1+2 (y^2)+(Sqrt[1-12 (y^2)])])),{y,0,(1/(2 (Sqrt[3])))}]

FullSimplify[(1/4) (2 (Sqrt[1-12 (y^2)])-(Sqrt[2+4 (y^2)-2 (Sqrt[1-12 (y^2)])])+(Sqrt[2]) (Sqrt[1+2 (y^2)+(Sqrt[1-12 (y^2)])]))/.y->((Cos[t])/(Sqrt[12])),0<t<(π/2)]

NIntegrate[(1/(12(Sqrt[12])))(6 Sin[t]+(Sqrt[3]) (-(Sqrt[6+((Cos[t])^2)-6 Sin[t]])+(Sqrt[6+((Cos[t])^2)+6 Sin[t]])))Sin[t],{t,0,π/2}]

FullSimplify[(1/(12(Sqrt[12])))(6 Sin[t]+(Sqrt[3]) (-(Sqrt[6+((Cos[t])^2)-6 Sin[t]])+(Sqrt[6+((Cos[t])^2)+6 Sin[t]])))Sin[t],0<t<π/2]

area1=Integrate[(1/24) Sin[t] (-(Sqrt[6+((Cos[t])^2)-6 Sin[t]])+2 (Sqrt[3]) Sin[t]+(Sqrt[6+((Cos[t])^2)+6 Sin[t]])),{t,0,π/2}]

N[%]

Top tailfin

NIntegrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,0},{y,0,∞}]

Integrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,0},{y,0,∞}]//Timing

Integrate[Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{y,0,∞},{x,-∞,0}]//Timing

FullSimplify[ToRadicals[(-Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,1]+Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,2])],0<y<1/(2(Sqrt[3]))]

...wrong...

Plot[{
(-Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,1]+Root[(y^4)+(y^2) #1+(y^2) ((#1)^2)-((#1)^3)+((#1)^4)&,2]),
((Sqrt[1+2 (y^2)-(Sqrt[1-12 (y^2)])])/(Sqrt[2]))},{y,0,(12^(-1/2))}]

FullSimplify[Subtract@@yeqns[[{3,1}]]]

NIntegrate[(1/4) (2 (Sqrt[1-12 (y^2)])+(Sqrt[2+4 (y^2)-2 (Sqrt[1-12 (y^2)])])-(Sqrt[2]) (Sqrt[1+2 (y^2)+(Sqrt[1-12 (y^2)])])),{y,0,(1/(2 (Sqrt[3])))}]

FullSimplify[(1/4) (2 (Sqrt[1-12 (y^2)])+(Sqrt[2+4 (y^2)-2 (Sqrt[1-12 (y^2)])])-(Sqrt[2]) (Sqrt[1+2 (y^2)+(Sqrt[1-12 (y^2)])]))/.y->((Cos[t])/(Sqrt[12])),0<t<(π/2)]

NIntegrate[(1/(12(Sqrt[12]))) (6 Sin[t]+(Sqrt[3]) ((Sqrt[6+((Cos[t])^2)-6 Sin[t]])-(Sqrt[6+((Cos[t])^2)+6 Sin[t]])))Sin[t],{t,0,π/2}]

FullSimplify[(1/(12(Sqrt[12]))) (6 Sin[t]+(Sqrt[3]) ((Sqrt[6+((Cos[t])^2)-6 Sin[t]])-(Sqrt[6+((Cos[t])^2)+6 Sin[t]])))Sin[t]]

area2=Integrate[(1/24) Sin[t] ((Sqrt[6+((Cos[t])^2)-6 Sin[t]])+2 (Sqrt[3]) Sin[t]-(Sqrt[6+((Cos[t])^2)+6 Sin[t]])),{t,0,π/2}]

Together

FullSimplify[2(area1+area2)]

N[%]

AreaInertiaTensor

NIntegrate[{{(y^2),-x y},{-y x,(x^2)}}Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,∞},{y,-∞,∞}]

((π/(4 (Sqrt[3])))/({0.009446871659399877`,0.15114994693821915`}))

{{(1/48),0},{0,(1/3)}}(π/(4 (Sqrt[3])))

N[%]

Integrate[{{(y^2),-x y},{-y x,(x^2)}}Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,∞},{y,-∞,∞}]

Centroid

(1/(π/(4 (Sqrt[3]))))NIntegrate[{x,y}Boole[x^4+x^2 y^2+y^4<x(x^2-y^2)],{x,-∞,∞},{y,-∞,∞},PrecisionGoal->10,WorkingPrecision->50]//Timing

Centroid[x^4+x^2 y^2+y^4< x(x^2-y^2),{x,y}]//Timing

N[%]

ImplicitCurvature

SortBy[FullSimplify[Curvature[trefoil,{x,y}],a>0],ByteCount]

Slope

FullSimplify[Slope[trefoil,{x,y}],a>0]//Union