Bicorn

Author

Eric W. Weisstein
February 16, 2012

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

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

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

Equation

Factor[GroebnerBasis[Append[Numerator[Together[{x,y}-a{Sin[t],(Cos[t]^2(2+Cos[t]))/(3+Sin[t]^2)}]],Sin[t]^2+Cos[t]^2-1],{x,y},{Cos[t],Sin[t]}]]

Expand[eqn=(x^2+2a y-a^2)^2-y^2(a^2-x^2)]

AlgebraicDegree[eqn,{x,y}]

Plot

V5

<<Graphics`ImplicitPlot`

ParametricPlot[{Sin[t],(Cos[t]^2(2+Cos[t]))/(3+Sin[t]^2)},{t,-Pi,Pi},Ticks->None,PlotStyle->Red]

ParametricPlot[{Sin[t],(Cos[t]^2(2+Cos[t]))/(3+Sin[t]^2)},{t,0,2π},Ticks->None,PlotStyle->Red]

ImplicitPlot[y^2(a^2-x^2)==(x^2+2a y-a)^2 /. a->1,{x,-1,1},Ticks->None,PlotStyle->Red]

V6

ContourPlot[Evaluate[eqn==0/.a->1],{x,-1,1},{y,0,1},Ticks->None,ContourStyle->Red,AspectRatio->Automatic]

Area

<<Graphics`InequalityGraphics`

Assuming[a>0,Area[(x^2+2a y-a^2)^2-y^2(a^2-x^2)<0,{x,y}]]//FullSimplify

InequalityPlot[y^2(a^2-x^2)>(x^2+2a y-a)^2 /. a->1,{x,-∞,∞},{y,-∞,∞}]

FullSimplify[Solve[y^2(a^2-x^2)==(x^2+2a y-a)^2/.a->1,y],-1<x<1]

Plot[{(((-1+(x^2)) (-2+(Sqrt[1-(x^2)])))/(3+(x^2))),((2-2 (x^2)+(((1-(x^2)))^(3/2)))/(3+(x^2)))},{x,-1,1},Filling->{1->{2}}]

Integrate[Boole[y^2(a^2-x^2)>(x^2+2a y-a)^2 /. a->1],{x,-∞,∞},{y,-∞,∞}]//Timing

N[%]

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

FullSimplify[%]

Factor[(1/3) a (-6+4 (Sqrt[3])+3 (-7+4 (Sqrt[3])) a) π/.a->1]

(1/3) (-27+16 (Sqrt[3])) π-(-9+16/Sqrt[3]) π//Simplify

Centroid

RegionPlot[y^2(1^2-x^2)-(x^2+2y-1^2)^2>0,{x,-1,1},{y,0,1},AspectRatio->Automatic,ImageSize->150]

With[{a=1},RegionPlot[(x^2+2a y-a^2)^2-y^2(a^2-x^2)<0,{x,-1,1},{y,0,1},AspectRatio->Automatic,ImageSize->150]]

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

N[%]

NIntegrate[{x,y}Boole[y^2(1^2-x^2)-(x^2+2y-1^2)^2>0],{x,-1,1},{y,0,1}]

Integrate[{x,y}Boole[y^2(1^2-x^2)-(x^2+2y-1^2)^2>0],{x,-1,1},{y,0,1}]//FullSimplify//Timing

N[Last[%]]

(xybar=Integrate[{x,y}Boole[y^2(a^2-x^2)-(x^2+2a y-a^2)^2>0],{x,-a,a},{y,0,a},Assumptions->a>0]//FullSimplify)//Timing

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

(area=Integrate[Boole[y^2(a^2-x^2)-(x^2+2a y-a^2)^2>0],{x,-a,a},{y,0,a},Assumptions->a>0]//FullSimplify)//Timing

FullSimplify[(xybar/area)]

Area Moment of Inertia

Integrate[AreaInertiaTensor[x,y]Boole[y^2(a^2-x^2)-(x^2+2a y-a^2)^2>0],{x,-a,a},{y,0,a},Assumptions->a>0]//FullSimplify

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

Properties

bicorn={a Sin[t],a Cos[t]^2(2+Cos[t])/(3+Sin[t]^2)};

Simplify[y^2(a^2-x^2)-(x^2+2a y-a^2)^2/.Thread[{x,y}->bicorn]]

Arc Length

FullSimplify[√((a^2) ((Cos[t])^2)+(((-((2 a ((Cos[t])^3) (2+Cos[t]) Sin[t])/(((3+((Sin[t])^2)))^2))-((a ((Cos[t])^2) Sin[t])/(3+((Sin[t])^2)))-((2 a Cos[t] (2+Cos[t]) Sin[t])/(3+((Sin[t])^2)))))^2)),a>0&&t>0]

FullSimplify[√(((Cos[t])^2)+(((-((2  ((Cos[t])^3) (2+Cos[t]) Sin[t])/(((3+((Sin[t])^2)))^2))-(( ((Cos[t])^2) Sin[t])/(3+((Sin[t])^2)))-((2  Cos[t] (2+Cos[t]) Sin[t])/(3+((Sin[t])^2)))))^2)),0<t<π]

FullSimplify[%,-π<t<π]

Refine[%,0<t<π]

Plot[((Abs[Cos[t]] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,-π,π},PlotStyle->Red]

Numeric

NIntegrate[((Abs[Cos[t]] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,-π,π}]//Timing

v4.2

Integrate[((Abs[Cos[t]] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,-π,π}]//Timing

Integrate[((Cos[t] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,0,π/2}]//Timing

v5.0.1

Integrate[((Abs[Cos[t]] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,-π,π}]//Timing

Integrate[((Cos[t] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,0,π/2}]//Timing

v5.1

Integrate[((Abs[Cos[t]] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,-π,π}]//Timing

Integrate[((Cos[t] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,0,π/2}]//Timing

v6

Integrate[((Abs[Cos[t]] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,-π,π}]//Timing

Integrate[((Cos[t] (Sqrt[73-80 Cos[t]+9 Cos[2 t]]))/((Sqrt[2]) (((2-Cos[t]))^2))),{t,0,π/2}]//Timing

Curvature

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

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

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

ByteCount/@%

Inflection Points

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

Block[{a=1},ContourPlot[eqn==0,{x,-1,1},{y,0,1},Epilog->{Point[{{-(((Sqrt[5]) a)/3),(a/3)},{(((Sqrt[5]) a)/3),(a/3)}}]}]]

Singularities

FullSimplify[SingularPoints[eqn,{x,y}],a>0]//Union

Slope

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

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

Tangential Angle

tangentialAngle[{x_,y_},t_,opts___?OptionQ]:=integrate[Curvature[{x,y},t] D[ArcLength[{x,y},t,opts],t],{t,0,t},opts]

tangentialAngle[bicorn,t]

Simplify[(a Sin[t] (-((2 a ((Cos[t])^3) (2+Cos[t]) Sin[t])/(((3+((Sin[t])^2)))^2))-((a ((Cos[t])^2) Sin[t])/(3+((Sin[t])^2)))-((2 a Cos[t] (2+Cos[t]) Sin[t])/(3+((Sin[t])^2))))+a Cos[t] (((a (2+Cos[t]) (-2 ((Cos[t])^2)+2 ((Sin[t])^2)))/(3+((Sin[t])^2)))-4 a Cos[t] Sin[t] (-((2 Cos[t] (2+Cos[t]) Sin[t])/(((3+((Sin[t])^2)))^2))-((Sin[t])/(3+((Sin[t])^2))))+a ((Cos[t])^2) (((4 Cos[t] ((Sin[t])^2))/(((3+((Sin[t])^2)))^2))-((Cos[t])/(3+((Sin[t])^2)))+(2+Cos[t]) (((8 ((Cos[t])^2) ((Sin[t])^2))/(((3+((Sin[t])^2)))^3))-((2 ((Cos[t])^2))/(((3+((Sin[t])^2)))^2))+((2 ((Sin[t])^2))/(((3+((Sin[t])^2)))^2))))))/((a^2) ((Cos[t])^2)+(((-((2 a ((Cos[t])^3) (2+Cos[t]) Sin[t])/(((3+((Sin[t])^2)))^2))-((a ((Cos[t])^2) Sin[t])/(3+((Sin[t])^2)))-((2 a Cos[t] (2+Cos[t]) Sin[t])/(3+((Sin[t])^2)))))^2))]

v5

TangentialAngle[bicorn,t]//Timing

Plot[t-ArcTan[((4 Sin[t])/(-4+5 Cos[t]))],{t,-π,2π},PlotStyle->Red]

v5.1

TangentialAngle[bicorn,t]//Timing

TangentialAngle[bicorn,t,Assumptions->t∈Reals]//Timing

TangentialAngle[bicorn,t,Assumptions->-Pi<t<Pi]//Timing

v6

$Version

TangentialAngle[bicorn,t]//Timing

TangentialAngle[bicorn,t,Assumptions->-Pi<t<Pi]//Timing

phi=-(1/(486 t))(-81 t+(-16+5 (Sqrt[7])) (Sqrt[431+160 (Sqrt[7])]) ArcTan[(((-29+4 (Sqrt[7])) Tan[(t/2)])/(Sqrt[431-160 (Sqrt[7])]))]+(Sqrt[431-160 (Sqrt[7])]) (16+5 (Sqrt[7])) ArcTan[(((29+4 (Sqrt[7])) Tan[(t/2)])/(Sqrt[431+160 (Sqrt[7])]))]);

FullSimplify[phi,-π<phi<π]

Plot[phi,{t,-2π,2π},PlotStyle->Red]

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

Integrate[((6 (-2+Cos[t]) (-2+3 Cos[t]))/(73-80 Cos[t]+9 Cos[2 t])),{t,0,t},Assumptions->-Pi<t<Pi]//Timing

N[ArcCos[4/5]]

Integrate[(((-2+Cos[(t^2)]) (-2+3 Cos[(t^2)]))/(73-80 Cos[(t^2)]+9 Cos[2 (t^2)])),{t,0,1},Assumptions->t>ArcCos[(4/5)]||t+ArcCos[(4/5)]<0]//Timing

Integrate[((6 (-2+Cos[t]) (-2+3 Cos[t]))/(73-80 Cos[t]+9 Cos[2 t])),{t,0,t},Assumptions->0<t<2Pi]//Timing

Integrate[(((-2+Cos[t]) (-2+3 Cos[t]))/(73-80 Cos[t]+9 Cos[2 t])),{t,0,t},Assumptions->t>ArcCos[(4/5)]]//Timing

<<Graphics`Colors`

Plot[Evaluate[{((t-ArcTan[((4 Sin[t])/(-4+5 Cos[t]))])/(6 t)),
((t+ArcTan[(-4+(Sqrt[7])) Tan[(t/2)]]-ArcTan[(4+(Sqrt[7])) Tan[(t/2)]])/(6 t))
(*,
Subtract@@{((t-ArcTan[((4 Sin[t])/(-4+5 Cos[t]))])/(6 t)),((t+ArcTan[(-4+(Sqrt[7])) Tan[(t/2)]]-ArcTan[(4+(Sqrt[7])) Tan[(t/2)]])/(6 t))}
*)
}],{t,-2π,2π},PlotRange->All,PlotStyle->{Red,Blue}]