Bifolium

Author

Eric W. Weisstein
January 4, 2024

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

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

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

Equations

Eliminate[Append[Thread[{x,y}==a 4 Cos[t]Sin[t]^2{Cos[t],Sin[t]}],Sin[t]^2+Cos[t]^2==1],{Sin[t],Cos[t]}]

FullSimplify[%]

Factor/@GroebnerBasis[{x-4a Cos[t]Sin[t]^2Cos[t],y-4a Cos[t]Sin[t]^2Sin[t],Cos[t]^2+Sin[t]^2-1}/.{Cos[t]->cos,Sin[t]->sin},{x,y},{cos,sin}]

FullSimplify[%[[1]]==0]

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

Degree

AlgebraicDegree[(x^2+y^2)^2==4 a x y^2,{x,y}]

Plots

Cartesian

ParametricPlot[4 Cos[t]Sin[t]^2{Cos[t],Sin[t]},{t,0,π},Ticks->None,PlotStyle->Red,ImageSize->Small]

ParametricPlot[4 Cos[t]Sin[t]^2{Cos[t],Sin[t]},{t,0,.5},Ticks->None,PlotStyle->Red,ImageSize->Small]

Polar

PolarPlot[4 Cos[t]Sin[t]^2,{t,0,Pi/2},Ticks->None,PlotStyle->Red,ImageSize->{Automatic,150}]

PolarPlot[4 Cos[t]Sin[t]^2,{t,0,Pi},Ticks->None,PlotStyle->Red,ImageSize->{Automatic,150}]

PolarPlot[4 Cos[t]Sin[t]^2,{t,0,2Pi},Ticks->None,PlotStyle->Red,ImageSize->{Automatic,150}]

Implicit

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

Properties

bifolium=4a Cos[t]Sin[t]^2{Cos[t],Sin[t]};

Area

Parametric

Area[bifolium,{t,0,π}]

Inequality

<<Graphics`InequalityGraphics`

With[{a=1},InequalityPlot[(x^2+y^2)^2<4a x y^2,{x},{y},Ticks->None]]

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

Cartesian

Area[bifolium,{t,0,π}]

Polar

(1/2)Integrate[(4a Cos[θ]Sin[θ]^2)^2,{θ,0,π}]

Integrate[(4a Cos[θ]Sin[θ]^2)^2,{θ,0,π/2}]

ArcLength

bug(443926): Integrate[Sqrt[4 Sin[t]^4 - 5 Sin[t]^2 + 2], {t, 0, Pi/2}] could return simpler result With[{m = (4 + Sqrt[2])/8}, 1/(4 2^(3/4)) (8 EllipticE[m] - 8 EllipticK[m] + (4 + 3 Sqrt[2]) EllipticPi[(4 - 3 Sqrt[2])/8, m])]/(4 Sqrt[2]) (instead of more complicated expression with explicit complex parts)

Integrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],θ]//Timing

Refine[FullSimplify[Sqrt[(4a Cos[θ]Sin[θ]^2)^2+D[4a Cos[θ]Sin[θ]^2,θ]^2],a>0&0<θ<π],a>0]

Refine[FullSimplify[Sqrt[(4a Cos[θ]Sin[θ]^2)^2+D[4a Cos[θ]Sin[θ]^2,θ]^2],a>0&0<θ<π/2],a>0]

4 (Sqrt[2])NIntegrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]

s=4 (Sqrt[2])NIntegrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2},WorkingPrecision->150]

v5.0.1

4(Sqrt[2])NIntegrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]

4(Sqrt[2])Integrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]//Timing

N[%]

...wrong...

Integrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],θ]

f=(-64 Cos[θ] (3+3 Cos[2 θ]+2 Cos[4 θ])+((Sqrt[((-3 I+(Sqrt[7])-8 I Cos[2 θ])/(5 I+(Sqrt[7])))]) (Sqrt[((3 I+(Sqrt[7])+8 I Cos[2 θ])/(-5 I+(Sqrt[7])))]) (1+5 Cos[2 θ]) (5 (-5 I+(Sqrt[7])) EllipticE[I ArcSinh[((4 (Sqrt[-(I/(5 I+(Sqrt[7])))]))/(Sqrt[((Sec[θ])^2)]))],((5 I+(Sqrt[7]))/(5 I-(Sqrt[7])))]-(7 I+5 (Sqrt[7])) EllipticF[I ArcSinh[((4 (Sqrt[-(I/(5 I+(Sqrt[7])))]))/(Sqrt[((Sec[θ])^2)]))],((5 I+(Sqrt[7]))/(5 I-(Sqrt[7])))]) Sec[θ] (Sqrt[((Sec[θ])^2)]))/((Sqrt[-(I/(5 I+(Sqrt[7])))]) (-3+2 ((Tan[θ])^2))))/(192 (Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]));

Plot[Re[f],{θ,0,π/2}]

Plot[Im[f],{θ,.70635,.70645},PlotStyle->Red]

v5.1

4(Sqrt[2])Integrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]//Timing

...hangs...

v5.2

4(Sqrt[2])Integrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]//Timing

v6

4(Sqrt[2])Integrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]//Timing

...crashes...

External

4(Sqrt[2])NIntegrate[(Sqrt[3+3 Cos[2 θ]+2 Cos[4 θ]]) Sin[θ],{θ,0,π/2}]

4(Sqrt[2])NIntegrate[(Sqrt[(3+3 Cos[2 θ]+2 (2Cos[2θ]^2-1))(1-Cos[2θ])/2]),{θ,0,π/2}]

Expand[(3+3 Cos[2 θ]+2 (2Cos[2θ]^2-1))(1-Cos[2θ])/2]

2NIntegrate[(Sqrt[1+2Cos[θ]+((Cos[θ])^2)-4 ((Cos[θ])^3)]),{θ,0,π}]

lprint (2*int (sqrt (3 + 3*cos (2*t) + 2*cos (4*t)^3)*sin (t), t = 0 .. Pi));

{ellipticK[k_]:>EllipticK[k^2],
ellipticE[k_]:>EllipticE[k^2],
ellipticE[x_,k_]:>EllipticE[x,k^2],
ellipticF[x_,k_]:>EllipticF[x,k^2],
ellipticPi[x_,y_,k_]:>EllipticPi[x,y,k^2]}/.{cos:>Cos,sin:>Sin};

By Hand

s0[t_]:=-((2Cos[t](12+11Sqrt[2]+4(8+5Sqrt[2])Cos[2t])Sqrt[3+3Cos[2t]+2Cos[4t]])/(3(5+4Sqrt[2])(2+Sqrt[2]+2Cos[2t])))-5/6Sqrt[-5+4Sqrt[2]]EllipticE[ArcSin[(-1+1/(2Sqrt[2])+Sin[t]^2)/(-1-1/(2Sqrt[2])+Sin[t]^2)],1/7(-57-40Sqrt[2])]-2/3Sqrt[-10+8Sqrt[2]]EllipticF[ArcSin[(-1+1/(2Sqrt[2])+Sin[t]^2)/(-1-1/(2Sqrt[2])+Sin[t]^2)],1/7(-57-40Sqrt[2])]

s0[π/2]-s0[0]

s0[π/2]-s0[0]//FullSimplify

N[%]

FullSimplify[s0[t]-s0[0]]

s[t_]:=(1/6) ((8/7) (8+5 (Sqrt[2]))-((4 Cos[t] (12+11 (Sqrt[2])+4 (8+5 (Sqrt[2])) Cos[2 t]) (Sqrt[3+3 Cos[2 t]+2 Cos[4 t]]))/((5+4 (Sqrt[2])) (2+(Sqrt[2])+2 Cos[2 t])))-5 (Sqrt[-5+4 (Sqrt[2])]) EllipticE[ArcSin[1-((2 (Sqrt[2]))/(2+(Sqrt[2])+2 Cos[2 t]))],(1/7) (-57-40 (Sqrt[2]))]+(Sqrt[-5+4 (Sqrt[2])]) (5 EllipticE[ArcSin[(1/7) (9-4 (Sqrt[2]))],(1/7) (-57-40 (Sqrt[2]))]+4 (Sqrt[2]) EllipticF[ArcSin[(1/7) (9-4 (Sqrt[2]))],(1/7) (-57-40 (Sqrt[2]))])-4 (Sqrt[-10+8 (Sqrt[2])]) EllipticF[ArcSin[1-((2 (Sqrt[2]))/(2+(Sqrt[2])+2 Cos[2 t]))],(1/7) (-57-40 (Sqrt[2]))])

N[s[π/2]]

s[π/2]//FullSimplify

(1/42) (35 (Sqrt[-5+4 (Sqrt[2])]) (EllipticE[(1/7) (-57-40 (Sqrt[2]))]+EllipticE[ArcSin[(1/7) (9-4 (Sqrt[2]))],(1/7) (-57-40 (Sqrt[2]))])+4 (2 (8+5 (Sqrt[2]))+7 (Sqrt[-10+8 (Sqrt[2])]) (EllipticF[ArcSin[(1/7) (9-4 (Sqrt[2]))],(1/7) (-57-40 (Sqrt[2]))]+EllipticK[(1/7) (-57-40 (Sqrt[2]))])))/.{ArcSin[(1/7) (9-4 (Sqrt[2]))]->ϕ,(1/7) (-57-40 (Sqrt[2]))->m}//TraditionalForm

(35*x*(EllipticE[ϕ, m] + EllipticE[m]) + 
   4*(7*(8*2^(1/2) - 10)^(1/2)*(EllipticF[ϕ, m] + EllipticK[m]) + 
     2*(8 + 5*2^(1/2))))/42/.{x->(4*2^(1/2) - 5)^(1/2),ϕ->ArcSin[(1/7) (9-4 (Sqrt[2]))],m->(1/7) (-57-40 (Sqrt[2]))}//N

(35*x*(EllipticE[ϕ, m] + EllipticE[m]) + 
   4*(7*(Sqrt[2])x*(EllipticF[ϕ, m] + EllipticK[m]) + 
    (Sqrt[ 2])(8 (Sqrt[2])+10)))/42/.{
x->(4*2^(1/2) - 5)^(1/2),
xp->(4*2^(1/2) + 5)^(1/2),
ϕ->ArcSin[(1/7) (9-4 (Sqrt[2]))],m->(1/7) (-57-40 (Sqrt[2]))}//N

(35*x*(EllipticE[ϕ, m] + EllipticE[m]) + 
   4*(7*(Sqrt[2])x*(EllipticF[ϕ, m] + EllipticK[m]) + 
   2 (Sqrt[ 2])xp^2))/42/.{
x->(4*2^(1/2) - 5)^(1/2),
xp->(4*2^(1/2) + 5)^(1/2),
ϕ->ArcSin[(1/7) (9-4 (Sqrt[2]))],m->(1/7) (-57-40 (Sqrt[2]))}//N

(35*x*(EllipticE[ϕ, m] + EllipticE[m]) + 
   4(Sqrt[2])*(7x*(EllipticF[ϕ, m] + EllipticK[m]) + 
   2 xp^2))/42/.{
x->(4*2^(1/2) - 5)^(1/2),
xp->(4*2^(1/2) + 5)^(1/2),
ϕ->ArcSin[(1/7) (9-4 (Sqrt[2]))],m->(1/7) (-57-40 (Sqrt[2]))}//N

(35*x*(EllipticE[ϕ, m] + EllipticE[m]) + 
   4(Sqrt[2])*(7x*(EllipticF[ϕ, m] + EllipticK[m]) + 
   2 xp^2))/42//TraditionalForm

Plot[s[t],{t,0,π/2}]

By hand new

$Version

N[expr=With[{c1=(Sqrt[4(Sqrt[2])-5]),c2=(Sqrt[4(Sqrt[2])+5]),phi=ArcSin[(1/7)(9-4(Sqrt[2]))],m=-(1/7)(57+40(Sqrt[2]))},(35c1(EllipticE[phi,m]+EllipticE[m])+4(Sqrt[2])(7c1(EllipticF[phi,m]+EllipticK[m])+2(c2^2)))/42],20]

expr

Table[(Sqrt[4(Sqrt[2])+5])^n,{n,2,6,2}]//Expand//Factor

Table[(Sqrt[4(Sqrt[2])-5])^n,{n,2,6,2}]//Expand//Factor

4-(4(Sqrt[2])-5)

N[expr=
With[{c1=(Sqrt[4(Sqrt[2])-5]),c2=(Sqrt[4(Sqrt[2])+5])},
With[{m=-((c2^4)/7),phi=ArcSin[((4-(c1^2))/7)]},(35c1(EllipticE[phi,m]+EllipticE[m])+4(Sqrt[2])(7c1(EllipticF[phi,m]+EllipticK[m])+2(c2^2)))/42]],20]

4(Sqrt[2])NIntegrate[Sqrt[3+3Cos[2t]+2Cos[4t]]Sin[t],{t,0,Pi/2}]

(int=4(Sqrt[2])Integrate[Sqrt[3+3Cos[2t]+2Cos[4t]]Sin[t],{t,0,Pi/2}])//Timing

N[int,20]

(intsimp=FullSimplify[4(Sqrt[2])int])//Timing

ByteCount/@{expr,int,intsimp}

AreaMomentOfInertia

Parametric

Assuming[a>0,AreaInertiaTensor[bifolium,{t,0,π}]]//Timing

Inequalities

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

FullSimplify[(x^2) (-(Sqrt[2 a x-(x^2)-2 (Sqrt[(a^2) (x^2)-a (x^3)])])+(Sqrt[2 a x-(x^2)+2 (Sqrt[(a^2) (x^2)-a (x^3)])])),0<x<a]

Integrate[(x^2) ((Sqrt[(2 a+2 (Sqrt[a (a-x)])-x) x])-(Sqrt[-x (-2 a+2 (Sqrt[a (a-x)])+x)])),{x,0,a},Assumptions->a>0]//Timing

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

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

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

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

Centroid

Parametric

Centroid[bifolium,{t,0,π}]

Inequality

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

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

Curvature

Plot[(((Sqrt[2]) Csc[θ] (3 ((Cos[θ])^4)+((Sin[θ])^4)))/( (((3+3 Cos[2 θ]+2 Cos[4 θ]))^(3/2)))),{θ,0,π},PlotStyle->Red]

v5.2

FullSimplify[Curvature[4a Cos[θ]Sin[θ]^2,θ],a>0&&0<θ<π]

Simplify[(((Sqrt[2]) Csc[θ] (3 ((Cos[θ])^4)+((Sin[θ])^4)))/(((3+3 Cos[2 θ]+2 Cos[4 θ]))^(3/2)))-(((3+2 Cos[2 θ]+Cos[4 θ]) Csc[θ])/((Sqrt[2]) (((3+3 Cos[2 θ]+2 Cos[4 θ]))^(3/2)))),0<θ<π]

v6

FullSimplify[Curvature[4a Cos[θ]Sin[θ]^2,θ],a>0&&0<θ<π]

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

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

ByteCount/@%

Polar

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

Singular Points

SingularPoints[eqn,{x,y}]

SpecialAffineCurvature

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

Slope

FullSimplify[Slope[4a Cos[t] Sin[t]^2 {Cos[t],Sin[t]},t]]

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

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

Tangential Angle

Plot[ArcCot[2 Cot[θ]-Tan[θ]],{θ,0,π},PlotStyle->Red]

v5

FullSimplify[TangentialAngle[4a Cos[θ]Sin[θ]^2,θ],0<θ<π]

v5.1

FullSimplify[TangentialAngle[4a Cos[θ]Sin[θ]^2,θ],0<θ<π]//Timing

v6

FullSimplify[TangentialAngle[4a Cos[θ]Sin[θ]^2,θ],0<θ<π]//Timing

TangentialAngle[bifolium,t,Assumptions->a>0&&0<t<π]

FullSimplify[TangentialAngle[bifolium,t],a>0&&0<t<π]

Vector Properties

parm=4a Cos[t] Sin[t]^2 {Cos[t],Sin[t]};
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