Kepler's Folium

Author

Eric W. Weisstein
August 25, 2021

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

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

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

Definition

folium[a_,b_][t_]:=Cos[t](4a Sin[t]^2-b){Cos[t],Sin[t]}

Equation

foliumxy=FullSimplify[Eliminate[Append[Thread[{x,y}==Cos[t](4a Sin[t]^2-b){Cos[t],Sin[t]}],Sin[t]^2+Cos[t]^2==1],{Sin[t],Cos[t]}]]

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

Gray's Form

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

gray/.x->x+b

Plot

V5

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
PolarPlot[Cos[t](4Sin[t]^2-#),{t,0,Pi},
PlotLabel->TraditionalForm[b/a==#],Ticks->None,PlotStyle->Red]&/@{4,2,1,0}
]]]

PolarPlot[Evaluate[Table[Cos[t](4Sin[t]^2-b),{b,0,4,.5}]],{t,0,Pi},Ticks->None,PlotStyle->{Red,Orange,Yellow,Green,DarkGreen,Blue,Hue[.5],Purple,Black}]

PolarPlot[Evaluate[Table[Cos[t](4Sin[t]^2-b),{b,0,4,.01}]],{t,0,Pi},Ticks->None,PlotStyle->Table[{Hue[i],Thickness[.007]},{i,0,1,.005}]]

V6

PolarPlot[Cos[t](4#1 Sin[t]^2-#2),{t,0,π}]&@@@{{1,4},{1,2},{1,1},{1,0}}

Special Cases

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

ImplicitPlot[%==0,{x,-3,5},Ticks->None,PlotStyle->Red]

ExpandAll[Subtract@@foliumxy/.{x->-x,a->1,b->0}]

Subtract@@foliumxy

ExpandAll[Subtract@@foliumxy/.{x->-x,a->1,b->4}]

ImplicitPlot[%==0,{x,-3,5},Ticks->None,PlotStyle->Red]

Properties

curve=Cos[t](4a Sin[t]^2-b){Cos[t],Sin[t]};

ArcLength

v4.2.1

ArcLength[folium,θ]

ArcLength[folium,{θ,0,π}]

v5

ArcLength[folium,θ]

ArcLength[folium,{θ,0,π}]

v6

ArcLength[folium,θ]//Timing

...crash...

ArcLength[folium,{θ,0,π}]//Timing

...crash...

V6.1

ArcLength[folium,t]

FullSimplify[√((((8 a ((Cos[t])^3) Sin[t]-2 Cos[t] Sin[t] (-b+4 a ((Sin[t])^2))))^2)+(((8 a ((Cos[t])^2) ((Sin[t])^2)+((Cos[t])^2) (-b+4 a ((Sin[t])^2))-((Sin[t])^2) (-b+4 a ((Sin[t])^2))))^2)),a>0&&b>0&&0<t<π]

Integrate[(Sqrt[6 (a^2)-2 a b+(b^2)+2 a ((a-b) (-2 Cos[2 t]+Cos[4 t])-2 a Cos[6 t])]),t,Assumptions->a>0&&b>0&&0<t<π]

Integrate[(Sqrt[6 (a^2)-2 a b+(b^2)+2 a ((a-b) (-2 Cos[2 t]+Cos[4 t])-2 a Cos[6 t])]),{t,0,π},Assumptions->a>0&&b>0]

Area

Area[folium,{θ,0,π}]

Area[folium,{t,0,π}]//Simplify

Polar

Assuming[a>0&&b>0,Area[Cos[q](4a ((Sin[q])^2)-b),{q,0,π}]]//Timing

Inequality

Assuming[a>0&&b>0,Area[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x,y}]]//Timing

Special Cases

<<Graphics`InequalityGraphics`

With[{a=1,b=4},InequalityPlot[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x},{y}]]

With[{a=1,b=4},NIntegrate[Boole[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2)],{x,-∞,∞},{y,-∞,∞}]]

(1/4) (2 (a^2)-2 a b+(b^2)) π/.{a->1,b->4.}

With[{a=1,b=1},InequalityPlot[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x},{y}]]

With[{a=1,b=1},NIntegrate[Boole[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2)],{x,-∞,∞},{y,-∞,∞}]]

(1/4) (2 (a^2)-2 a b+(b^2)) π/.{a->1,b->1.}

With[{a=1,b=2},InequalityPlot[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x},{y}]]

With[{a=1,b=2},NIntegrate[Boole[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2)],{x,-∞,∞},{y,-∞,∞}]]

(1/4) (2 (a^2)-2 a b+(b^2)) π/.{a->1,b->2.}

With[{a=1,b=0},InequalityPlot[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x},{y}]]

With[{a=1,b=0},NIntegrate[Boole[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2)],{x,-∞,∞},{y,-∞,∞}]]

(1/4) (2 (a^2)-2 a b+(b^2)) π/.{a->1,b->0.}

AreaInertiaTensor

Assuming[a>0&&b>0,AreaInertiaTensor[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x,y}]]//Timing

Assuming[a>0&&b>0,AreaInertiaTensor[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{y,x}]]//Timing

Assuming[a>0&&b>0,AreaInertiaTensor[Cos[q](4a ((Sin[q])^2)-b),{q,0,π}]]//Factor//Timing

Centroid

Assuming[a>0&&b>0,Centroid[Cos[q](4a ((Sin[q])^2)-b),{q,0,π}]]//FullSimplify//Timing

Assuming[a>0&&b>0,Centroid[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{x,y}]]//Timing

Assuming[a>0&&b>0,Centroid[((x^2)+(y^2)) (x (b+x)+(y^2))<4 a x (y^2),{y,x}]]//Timing

Curvature

Parametric

FullSimplify[Curvature[folium,t],0<t<π&&a>0&&b>0]

Polar

FullSimplify[Curvature[Cos[q] (4 a Sin[q]^2-b),q],a>0&&b>0&&0<q<2π]

Implciit

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

ByteCount/@%

Slope

Slope[Cos[t] (4 a Sin[t]^2-b) {Cos[t],Sin[t]},t]//FullSimplify

Slope[Cos[q] (4 a Sin[q]^2-b),q]//FullSimplify

Slope[(x^2+y^2) (x (b+x)+y^2)==4 a x y^2,{x,y}]//FullSimplify

SpecialAffineCurvature

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

Tangential Angle

v5

FullSimplify[TangentialAngle[folium,θ],0<θ<π]

v6

FullSimplify[TangentialAngle[folium,θ],0<θ<π]

V6.1

TangentialAngle[folium,t,Assumptions->t>0&&a>0&&b>0]

FullSimplify[Curvature[folium,t] Sqrt[#.#&[D[folium,t]]],0<t<π&&a>0&&b>0]

Integrate[((-2 (8 (a^2)-2 a b+(b^2))+4 a Cos[2 t] (2 a-3 b+2 a Cos[4 t]))/(-6 (a^2)+2 a b-(b^2)+2 a (-(a-b) (-2 Cos[2 t]+Cos[4 t])+2 a Cos[6 t]))),{t,0,t},Assumptions->a>0&&b>0&&0<t<π]

Vector Properties

parm=Cos[t] (4 a Sin[t]^2-b) {Cos[t],Sin[t]};
assum=a>0&&b>0&&0<t<π;
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]]