Folium of Descartes

Author

Eric W. Weisstein
June 6, 2014

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

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

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

Equation

folium=3a{t,t^2}/(1+t^3);

Cartesian

Eliminate[Thread[{x,y}==a{3t,3t^2}/(1+t^3)],t]

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

Polar

ArcTan[Divide@@Reverse[folium]]

FullSimplify[#.#&[folium],a>0]

FullSimplify[Sqrt[#.#]&[folium]/.t->Tan[θ],a>0]

PowerExpand[%]//FullSimplify

Plot

Implicit

ContourPlot[x^3+y^3==3x y,{x,-3,3},{y,-3,3},ContourStyle->Red,AspectRatio->Automatic]

Parametric

ParametricPlot[folium/.a->1,{t,-30,-1,30},PlotStyle->Red,ImageSize->Small,PlotRange->3]

ParametricPlot[folium/.a->1,{t,-20,20},PlotStyle->Red,ImageSize->Small,PlotRange->3]

Polar

Plot[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,-π,π},PlotStyle->Red]

PolarPlot[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,0,π/2},PlotStyle->Red,ImageSize->Small]

PolarPlot[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,-.4,2},PlotStyle->Red,ImageSize->Small]

FullSimplify[D[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),θ]]

Solve[Tan[θ]==-1,θ,Reals]

Plot[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,-.79,2.6}]

N[{2 ArcTan[1-(Sqrt[2])],2 ArcTan[1+(Sqrt[2])]}]

PolarPlot[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,-.78,2.3},PlotStyle->Red,ImageSize->Small]

With[{ϵ=.001},PolarPlot[((3 Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,2 ArcTan[1-(Sqrt[2])]+ϵ,2 ArcTan[1+(Sqrt[2])]-ϵ},PlotStyle->Red,ImageSize->Small]]

Show[Block[{$DisplayFunction=Identity},
{
ParametricPlot[{3t,3t^2}/(1+t^3),Evaluate[{t,Sequence@@#}],PlotStyle->Red]&/@{{0,50},{-1,0},{-50,-1}},
Plot[-(1+t),{t,-5,5},PlotStyle->{Blue,Dashing[{.03}]}]
}
],AspectRatio->Automatic,Ticks->None,PlotRange->{{-1,1},{-1,1}}3]

Properties

folium=3a{t,t^2}/(1+t^3);

Arc Length

folium

Limit[{((3 t)/(1+(t^3))),((3 (t^2))/(1+(t^3)))},t->#]&/@{0,∞}

ParametricPlot[{((3 t)/(1+(t^3))),((3 (t^2))/(1+(t^3)))},{t,0,10},PlotRange->All]

FullSimplify[Sqrt[#.#]&[D[folium,t]],a>0&&t>0]

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

Integrate[((3(Sqrt[1+(t^2) (4-4 t-4 (t^3)+4 (t^4)+(t^6))]))/(((1+(t^3)))^2)),{t,0,∞}]

Arc Length Function

Numerical

NIntegrate[((3 (Sqrt[1+(t^2) (4-4 t-4 (t^3)+4 (t^4)+(t^6))]))/(((1+(t^3)))^2)),{t,0,∞},WorkingPrecision->20]

v5.2

ArcLength[folium,t]//Timing

v6

ArcLength[folium,t,Assumptions->a>0&&t∈Reals]

FullSimplify[(Sqrt[(((-((9 a (t^3))/(((1+(t^3)))^2))+((3 a)/(1+(t^3)))))^2)+(((-((9 a (t^4))/(((1+(t^3)))^2))+((6 a t)/(1+(t^3)))))^2)]),a>0&&t>0]

Integrate[((3 a (Sqrt[1+(t^2) (4-4 t-4 (t^3)+4 (t^4)+(t^6))]))/(((1+(t^3)))^2)),{t,0,t}]

Area

<<Graphics`InequalityGraphics`

InequalityPlot[x^3+y^3<3x y&&x>0&&y>0,{x},{y},Ticks->None,ImageSize->200]

Show[Block[{$DisplayFunction=Identity},
{
InequalityPlot[x^3+y^3<3x y&&x>0&&y>0,{x},{y},Curves->None],
ParametricPlot[{3t,3t^2}/(1+t^3),Evaluate[{t,Sequence@@#}],PlotStyle->Red]&/@{{0,50},{-1,0},{-50,-1}},
Plot[-(1+t),{t,-5,5},PlotStyle->{Blue,Dashing[{.03}]}]
}
],AspectRatio->Automatic,Ticks->None,PlotRange->{{-1,1},{-1,1}}3]

Area[{3t,3t^2}/(1+t^3),{t,0,∞}](a^2)

(3/2)(a^2)Integrate[((3(t^2))/(((1+(t^3)))^2)),{t,0,∞}]

Area[((3a Sec[θ] Tan[θ])/(1+((Tan[θ])^3))),{θ,0,π/2}]

Curvature

v5.2

Simplify[Curvature[folium,t],t>0]

v6

FullSimplify[Curvature[folium,t],a>0&&t∈Reals]

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

Polar

FullSimplify[Curvature[3 a Sec[q] Tan[q]/(1+Tan[q]^3),q],a>0&&2 ArcTan[1-(Sqrt[2])]<q<2 ArcTan[1+(Sqrt[2])]]

Inflection Points

{x,y}/.Solve[eqn==2 (a^3) x y==0,{x,y}]//Union

InflectionPoints[eqn,{x,y}]

Singular Points

SingularPoints[eqn,{x,y}]

Slope

Slope[3 a {t,t^2}/(1+t^3),t]//FullSimplify

Slope[3a Sec[q] Tan[q]/(1+Tan[q]^3),q]//FullSimplify

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

SpecialAffineCurvature

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

Tangential Angle

v4.2.1

FullSimplify[TangentialAngle[folium,t]]

v5

TangentialAngle[folium,t]

FullSimplify[TangentialAngle[folium,t]]

v6

TangentialAngle[folium,t]

Plot[ArcTan[((t (-2+(t^3)))/(-1+2 (t^3)))],{t,0,5},PlotStyle->Red]

Plot[Evaluate[expr1-(expr2+UnitStep[t-.7937]Pi)],{t,.7,.8},PlotStyle->Hue[0],PlotRange->All]

V6.1

FullSimplify[TangentialAngle[folium,t],a>0&&t∈Reals]

Plot[((t (-2+(t^3)))/(-1+2 (t^3))),{t,-2,4}]

Plot[ArcTan[((t (-2+(t^3)))/(-1+2 (t^3)))],{t,-5,10}]

FindRoot[-1+2 (t^3)==0,{t,.5}]

Reduce[-1+2 (t^3)==0,t,Reals]

Limit[ArcTan[((t (-2+(t^3)))/(-1+2 (t^3)))],t->(1/(2^(1/3))),Direction->#]&/@{-1,1}

Plot[ArcTan[((t (-2+(t^3)))/(-1+2 (t^3)))]+UnitStep[t-(1/(2^(1/3)))]π,{t,-5,10}]

Vector Properties

parm=3 a {t,t^2}/(1+t^3);
assum=a>0&&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]]