Links Curve

Author

Eric W. Weisstein
February 1, 2018

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

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

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

Definition

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

FullSimplify[(x^2+y^2-3 x)^2==4 x^2 (2-x)/.{x->x/a,y->y/a},a>0]

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

FullSimplify[eqn0-eqn/.a->1]

Equation

Expand[eqn]

AlgebraicDegree[eqn,{x,y}]

Plot

V5

<<Graphics`ImplicitPlot`

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

V6

ContourPlot[eqn==0,{x,-.1,2.1},{y,-2.2,2.2},AspectRatio->Automatic]

Properties

Area

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

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

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

(wing=Integrate[Boole[(x^2+y^2-3x)^2>4x^2(2-x)&&(x-1/2)^2+y^2<(1/2)^2],{x,-∞,∞},{y,-∞,∞}])//Timing

N[wing]

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

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

Simplify[wing+blob]

N[%]

Signed Area (excluding middle "wing")

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

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

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

N[(1/3) (8+3 π)]

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

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

AreaMomentOfIntertia

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

Centroid

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

FullSimplify[Last[%]]

N[%]

Curvature

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

ByteCount/@%

Singular Points

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

Slope

Slope[eqn==0,{x,y}]//FullSimplify[#,a>0]&

Union[%]