Heart Curve

Author

Eric W. Weisstein
February 14, 2023

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

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

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

Additional Authors

"Pointy" heart contributed by H. Dascanio, June 21, 2003

Squished heart contributed by Pavel Kuriscak, February 12, 2006

"Greeting card" cube root card from Judith Schroeder, October 16, 2021

Heart curve #7 from Jan Mangaldan, February 14, 2023

All

Typesetting

MakeBoxes[label,TraditionalForm]:=GridBox[{{RowBox[{RowBox[{"x","==",RowBox[{"sin"," ","t"," ","cos"," ","t"," ","ln",RowBox[{"\[LeftBracketingBar]","t","\[RightBracketingBar]"}]}]}]," "}]},{RowBox[{"y","==",RowBox[{SuperscriptBox[RowBox[{"\[LeftBracketingBar]","t","\[RightBracketingBar]"}],"0.3"]," ",SuperscriptBox[RowBox[{"(",RowBox[{"cos"," ","t"}],")"}],RowBox[{"1","/","2"}]]}]}]}}]

MakeBoxes[label,TraditionalForm]:=GridBox[{{RowBox[{RowBox[{"x","==",RowBox[{
   RowBox[{"sin", "", "t"}], " ", 
   RowBox[{"cos", "", "t"}], " ", 
   RowBox[{"ln", "", 
    TemplateBox[{"t"},
     "Abs"]}]}]}]," "}]},{RowBox[{"y","==",RowBox[{SuperscriptBox[RowBox[{"\[LeftBracketingBar]","t","\[RightBracketingBar]"}],"0.3"]," ",SuperscriptBox[RowBox[{"(",RowBox[{"cos"," ","t"}],")"}],RowBox[{"1","/","2"}]]}]}]}}]

Graphics Array

With[{style=Directive[10,Black,FontFamily->"Times New Roman"],width=800,color=Red},GraphicsGrid[
Partition[
{
(* 0 *)
PolarPlot[1-Sin[t],
{t,0,2π},
Ticks->None,
PlotStyle->color,
PlotLabel->r==1-Sin[θ],
LabelStyle->style
],

(* 1 *)
ContourPlot[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)==0,{x,-1.2,1.2},{y,-1,1.3},
Frame->False,
PlotLabel->-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)==0,
ContourStyle->color,
Axes->True,
Ticks->None,
LabelStyle->style
],

(* 2 *)
ParametricPlot[{Log[Abs[t]]Sin[t]Cos[t],Abs[t]^.3Sqrt[Cos[t]]},
{t,-1,1},
AspectRatio->Automatic,
PlotPoints->100,
PlotStyle->color,
PlotRange->All,
Ticks->False,
PlotLabel->Column@Thread[{x,y}=={Log[Abs[t]]Sin[t]Cos[t],Abs[t]^.3Sqrt[Cos[t]]}],
LabelStyle->style
],

(* 3 *)
Plot[2/3((x^2+Abs[x]-6)/(x^2+Abs[x]+2))+#(36-x^2)^(1/2)&/@{-1,1},
{x,-6,6},
PlotStyle->color,
AspectRatio->Automatic,
Ticks->False,
PlotLabel->(y-(2/3((x^2+Abs[x]-6)/(x^2+Abs[x]+2))))^2+x^2==36,
LabelStyle->style
],

(* 4 *)
PolarPlot[2-2Sin[t]+Sin[t]((Sqrt[Abs[Cos[t]]])/(Sin[t]+(7/5))),
{t,0,2π},
PlotStyle->color,
Ticks->False,
PlotLabel->r==2-2Sin[t]+Sin[t]((Sqrt[Abs[Cos[t]]])/(Sin[t]+(7/5))),
LabelStyle->style
],

(* 5 *)
ParametricPlot[
{16 ((Sin[t])^3),13 Cos[t]-5 Cos[2 t]-2 Cos[3 t]-Cos[4 t]},
{t,-π,π},
AspectRatio->Automatic,
PlotPoints->100,
PlotStyle->color,
PlotRange->All,
Ticks->False,PlotLabel->TextCell[Column[Thread[{x,y}=={16 ((Sin[t])^3),13 Cos[t]-5 Cos[2 t]-2 Cos[3 t]-Cos[4 t]}],Alignment->Left],PageWidth->width/3],
LabelStyle->style
],

(* 6 *)
ContourPlot[
(x^2)+(((y-(((x^2))^(1/3))))^2)==1,
{x,-1,1},{y,-1,1.6},
Frame->False,
PlotLabel->-(x^2)+(((y-(((x^2))^(1/3))))^2)==1,
ContourStyle->color,
Axes->True,
Ticks->None,
LabelStyle->style
],

(* 7 *)
ParametricPlot[
{-Sqrt[2] Sin[t]^3,2 Cos[t]-Cos[t]^2-Cos[t]^3},
{t,0,2 Pi},
PlotLabel->TextCell[Column[Thread[{x,y}=={Sqrt[2] Sin[t]^3,2 Cos[t]-Cos[t]^2-Cos[t]^3}],Alignment->Left],PageWidth->width/3],
PlotStyle->color,
Axes->True,
Ticks->None,
LabelStyle->style
]
},UpTo[3]],ImageSize->800,Alignment->Top,Dividers->All,Spacings->{-10,0}]]

Cardioid

PolarPlot[1-Sin[θ],{θ,0,2π},PlotStyle->Red]

Area[1-Sin[θ],{θ,0,2π}]

HeartCurve1

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

Expand[Subtract@@eqn]

RegionPlot[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0,{x,-1.2,1.2},{y,-1,1.4},Frame->False,Axes->True,PlotStyle->Red]

FullSimplify[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)/.{x->r Cos[t],y->r Sin[t]}]

With[{a=1},RegionPlot[((((x^2)+(y^2)-(a^2)))^3)<a (x^2) (y^3),{x,-1.2,1.2},{y,-1,1.4},Frame->False,Axes->True,PlotStyle->Red,BoundaryStyle->None]]

With[{a=2},RegionPlot[((((x^2)+(y^2)-(a^2)))^3)<a (x^2) (y^3),{x,-1.2 2,1.2 2},{y,-1 2,1.4 2},Frame->False,Axes->True,PlotStyle->Red,BoundaryStyle->None]]

Area

CAD

cad=CylindricalDecomposition[((((x^2)+(y^2)-1))^3)<(x^2) (y^3),{x,y},"Function"]

NIntegrate[Boole[cad],{x,y}∈FullRegion[2]]

NIntegrate[Boole[cad],{x,y}∈FullRegion[2]]

CAD over 1/2

cad=CylindricalDecomposition[((((x^2)+(y^2)-1))^3)<(x^2) (y^3)&&x>0,{x,y},"Function"]

2NIntegrate[Boole[cad],{x,y}∈FullRegion[2]]

2Integrate[Boole[cad],{x,y}∈FullRegion[2]]

Boole

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

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

N[%]//Chop

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

Integrate[Boole[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0],{x,0,∞},{y,-∞,∞}]

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

2NIntegrate[Boole[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0],{x,0,∞},{y,-∞,∞},WorkingPrecision->20]

Solve for x(y)

Maximize[{#,-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)==0},{x,y}]&/@{x,y}

N[%]

ContourPlot[-(x^2) (z^3)+(((-1+(x^2)+(z^2)))^3)==0,{x,-1.4,1.4},{z,-1.2,1.3},ContourStyle->Red,AspectRatio->Automatic]

Solve[-x2 (y^3)+(((-1+x2+(y^2)))^3)==0,x2]

Plot[1-(y^2)+((((((2/3)))^(1/3)) (y^3))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))+((((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))/((2^(1/3)) (3^(2/3)))),{y,-1,1.2366}]

Plot[Re[1-(y^2)-(((1-I (Sqrt[3])) (y^3))/((2^(2/3)) (3^(1/3)) (((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))))-(((1+I (Sqrt[3])) (((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))/(2 (2^(1/3)) (3^(2/3))))],{y,1.001,1.236}]

-Root[27-54 ((#1)^2)+4 ((#1)^3)+27 ((#1)^4)&,1]//N

i1=Inactive[Integrate][√(1-(y^2)+((((((2/3)))^(1/3)) (y^3))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))+((((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))/((2^(1/3)) (3^(2/3))))),{y,-1,-Root[27-54 ((#1)^2)+4 ((#1)^3)+27 ((#1)^4)&,1]}]

i2=Inactive[Integrate][√(1-(y^2)-(((1-I (Sqrt[3])) (y^3))/((2^(2/3)) (3^(1/3)) (((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))))-(((1+I (Sqrt[3])) (((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))/(2 (2^(1/3)) (3^(2/3))))),{y,1,-Root[27-54 ((#1)^2)+4 ((#1)^3)+27 ((#1)^4)&,1]}]

2(i1-i2)/.Inactive[Integrate]->NIntegrate

2Activate[i1-i2]//Timing

Integrate[((((((2/3)))^(1/3)) (y^3))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))),y]

Integrate[((((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))/((2^(1/3)) (3^(2/3)))),y]

Green's theorem

ParametricPlot[{1-(y^2)+((((((2/3)))^(1/3)) (y^3))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))+((((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))/((2^(1/3)) (3^(2/3)))),y},{y,-1,-Root[27-54 ((#1)^2)+4 ((#1)^3)+27 ((#1)^4)&,1]}]

<<MathWorld`Curves`

-Integrate[g D[f,t],{t,t0,t1},assum]

FullSimplify[y D[1-(y^2)+((((((2/3)))^(1/3)) (y^3))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))+((((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))/((2^(1/3)) (3^(2/3)))),y]]

Integrate[y (-2 y+(((2^(1/3)) (3^(2/3)) (y^2))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[(y^6) (27+(y^2) (-54+y (-4+27 y)))])))^(1/3)))-((((((2/3)))^(1/3)) (y^3) (27 (y^2)-45 (y^4)+((9 (y^5) (9+(y^2) (-4+3 y) (6+5 y)))/(Sqrt[9 (y^6)+(1/3) (y^8) (-54+y (-4+27 y))]))))/(3 (((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[(y^6) (27+(y^2) (-54+y (-4+27 y)))])))^(4/3))))+((27 (y^2)-45 (y^4)+((9 (y^5) (9+(y^2) (-4+3 y) (6+5 y)))/(Sqrt[9 (y^6)+(1/3) (y^8) (-54+y (-4+27 y))])))/(3 (2^(1/3)) (3^(2/3)) (((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[(y^6) (27+(y^2) (-54+y (-4+27 y)))])))^(2/3))))),y]

MyArea[{1-(y^2)+((((((2/3)))^(1/3)) (y^3))/(((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3)))+((((9 (y^3)-9 (y^5)+(Sqrt[3]) (Sqrt[27 (y^6)-54 (y^8)-4 (y^9)+27 (y^10)])))^(1/3))/((2^(1/3)) (3^(2/3)))),y},{y,-1,-Root[27-54 ((#1)^2)+4 ((#1)^3)+27 ((#1)^4)&,1]}]

Solve for y(x)

Solve[-x^2 (y^3)+(((-1+x^2+(y^2)))^3)==0,y]

AreaInertiaTensor

AreaInertiaTensor[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0,{x,y}]

N[%]//Chop

AreaInertiaTensor[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0,{y,x}]

N[%]//Chop

Centroid

Centroid[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0,{x,y}]

N[%]//Chop

Centroid[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<0,{y,x}]

N[%]//Chop

Curvature

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

ByteCount/@%

Inflection Points

infl=InflectionPoints[eqn,{x,y}]

Singular Points

pts=Union[SingularPoints[eqn,{x,y}]]

ContourPlot[eqn==0,{x,-1.4,1.4},{y,-1.4,1.6},Epilog->{PointSize[.02],Point[pts],Red,Point[infl]}]

Slope

SortBy[FullSimplify[Slope[eqn,{x,y}],a>0],ByteCount]

ByteCount/@%

HeartCurve2

Equation

par[t_]:=a{Sin[t]Cos[t]Log[Abs[t]],((Sqrt[(t^2)])^(3/10))(Sqrt[Cos[t]])}

Solve[And@@Thread[{x,y}==par[t]],{x,y},t]

FullSimplify[par[t]^2,0<t<1]

Eliminate[{x^2==((Cos[t])^2) ((Log[t])^2) ((Sin[t])^2),y^2==(t^(3/5)) Cos[t]},t]

Solve[x^2==((Cos[t])^2) ((Log[t])^2) ((Sin[t])^2)&&-1<t<1,t]

Solve[y^2==(t^(3/5)) Cos[t]&&-1<t<1,t]

Plot

Limit[par[t],t->1]

Limit[par[t],t->0]

ParametricPlot[par[t],{t,-1,1},PlotStyle->Red,PlotRange->All]

curve={Sin[t]Cos[t]Log[Abs[t]],((Sqrt[(t^2)])^(3/10))(Sqrt[Cos[t]])};

plot=ParametricPlot[par[t],{t,-1,1},PlotStyle->Red,PlotRange->All];

Graphics[Polygon[Flatten[Cases[plot,Line[x_]:>x,∞],1]]]

Top part

Plot[Sin[t]Cos[t]Log[Abs[t]],{t,-1,1}]

Minimize[{Sin[t]Cos[t]Log[Abs[t]],Abs[t]<1},t]//FullSimplify

N[%]

N[t0=Root[{Sin[2 #1]+2 Cos[2 #1] Log[#1] #1&,0.31450905197322821290712809469216814072`23.6}]]

N[x0=-(1/2)Log[t0]Sin[2t0]]

N[y0=((Sqrt[(t0^2)])^(3/10))(Sqrt[Cos[t0]])]

Show[{
ParametricPlot[par[t],{t,-t0,t0},PlotStyle->Red,PlotRange->All],
ParametricPlot[par[t],{t,-1,-t0},PlotStyle->Blue,PlotRange->All],
ParametricPlot[par[t],{t,t0,1},PlotStyle->Green,PlotRange->All],
Graphics[Point[{x0,y0}]]
}]

bot=ParametricPlot[par[t],{t,-t0,t0},PlotRange->All];

Graphics[{
Polygon[Join@@Cases[bot,Line[x_]:>x,∞]],
PointSize[.02],
Green,Point[par[-t0]],
Red,Point[par[t0]]
}
]

left=ParametricPlot[par[t],{t,t0,1},PlotRange->All];

Graphics[{
Polygon[Prepend[Cases[left,Line[x_]:>x,∞][[1]],{0,y0}]],
PointSize[.02],
Green,Point[par[t0]],
Red,Point[par[1]]
}]

right=ParametricPlot[par[t],{t,-t0,-1},PlotRange->All];

Graphics[{
Polygon[Prepend[Cases[right,Line[x_]:>x,∞][[1]],{0,y0}]],
PointSize[.02],
Green,Point[par[-t0]],
Red,Point[par[-1]]
}]

Graphics[{Polygon[poly=Join[
Join@@Cases[right,Line[x_]:>x,∞],
Join@@Cases[bot,Line[x_]:>x,∞],
Join@@Cases[left,Line[x_]:>x,∞]
]]}]

Graphics[Polygon[poly=Join@@((Join@@Cases[#,Line[x_]:>x,∞])&/@{right,bot,left})]]

Graphics[Polygon[Flatten[Cases[#,Line[x_]:>x,∞]&/@{right,bot,left},2]]]

Graphics[{EdgeForm[$plotstyle[[1]]],FaceForm[Directive[Hue[0.67,0.6,0.6],Opacity[0.2]]],Polygon[Flatten[Cases[#,Line[x_]:>x,∞]&/@{right,bot,left},2]]}]

Arc Length

ArcLength[par[t]/.Abs[t]:>Sqrt[t^2],{t,-1,1}]//Timing

Arc Length Function

ArcLength[par[t]/.Abs[t]:>Sqrt[t^2],t]//Timing

Area

Parametric

Area[curve,{t,-1,1}]//Timing

area[{f_,g_},{t_,t0_,t1_},assum___?OptionQ]:=integrate[f D[g,t]-g D[f,t],{t,t0,t1},assum]/2

FullSimplify[area[{Sin[t]Cos[t]Log[Sqrt[t^2]],((Sqrt[t^2])^(3/10))(Sqrt[Cos[t]])},{t,-1,1}],-1<t<1]

(1/2)NIntegrate[((t (Sqrt[Cos[t]]) (-5 t (1+3 Cos[2 t]) Log[(t^2)]+(-20+Log[(t^6)]) Sin[2 t]))/(40 ((Abs[t])^(17/10)))),{t,-1,1}]

Area[{Sin[t]Cos[t]Log[Sqrt[t^2]],((Sqrt[t^2])^(3/10))(Sqrt[Cos[t]])},{t,-1,1}]//Timing

Last[%]/.Integrate:>NIntegrate

Numeric

-(1/2)NIntegrate[((t (Sqrt[Cos[t]]) (-5 t (1+3 Cos[2 t]) Log[(t^2)]+(-20+Log[(t^6)]) Sin[2 t]))/(40 ((Abs[t])^(17/10)))),{t,-1,1},WorkingPrecision->20]

AreaMomentOfInertia

Centroid

Curvature

Curvature[par[t]/.Abs[c_]:>Sqrt[c^2],t]

Simplify[%,-1<t<1&&a>0]

FullSimplify[%,-1<t<1&&a>0]

Plot[κ,{t,-1,1}]

Plot[κ,{t,-.02,.02}]

Inflection Points

Numerator[κ]

expr=-5 ((Abs[t])^(13/10)) (4 t ((Cos[t])^4) (120+(21+50 (t^2)) Log[(t^2)])-8 ((Cos[t])^3) (9+50 (t^2)+45 (t^2) Log[(t^2)]) Sin[t]-40 (t^2) Cos[t] (-25+3 Log[(t^2)]) ((Sin[t])^3)-100 (t^3) Log[(t^2)] ((Sin[t])^4)+t (40+7 (-3+25 (t^2)) Log[(t^2)]) ((Sin[2 t])^2));

FindInstance[expr==0&&0<t<.1,t]

...hangs...

root=t/.FindRoot[expr==0,{t,.1},WorkingPrecision->40]

κ/.t->root

Root[{Function[t,Evaluate[expr]],root}]

FullSimplify[%]

pts={{-1,1}#,#}&@par[Root[{-5 (((((#1)^2)))^(13/10)) (-72 ((Cos[#1])^3) Sin[#1]+4 ((Cos[#1])^2) (80+Cos[2 #1] (40+21 Log[((#1)^2)])) #1+5 ((#1)^2) (-6 (-5+2 (2+Cos[2 #1]) Log[((#1)^2)]) Sin[2 #1]-35 Sin[4 #1]+5 (5+6 Cos[2 #1]-3 Cos[4 #1]) Log[((#1)^2)] #1))&,0.08471706208448236459147188893984802117242277659503120813605607299500953204206`40.}]]

FullSimplify[pts]

ExpToTrig[%%]

pts//N

ParametricPlot[par[t],{t,-1,1},PlotRange->All,Epilog->{Point[pts//N]}]

InflectionPoints[par[t],t]

Singular Points

par/@{-1,0,1}

N[%]

Limit[par[t],t->0]

ParametricPlot[par[t],{t,-1,1},PlotStyle->Red,PlotRange->All]

Slope

FullSimplify[Slope[par[t],t],-1<t<1&&a>0]

SpecialAffineCurvature

ByteCount[k=SpecialAffineCurvature[par[t],t]]//Timing

Simplify[k,-1<t<1&&a>0]//Timing

Tangential Angle

TangentialAngle[par[t]/.Abs[c_]:>Sqrt[c^2],t]

Vector Properties

parm=a{Sin[t] Cos[t] Log[Abs[t]],Sqrt[t^2]^(3/10) Sqrt[Cos[t]]};
assum=-1<t<1&&a>0;
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]]

HeartCurve3

Equation

(((y-((2 ((Abs[x])+(x^2)-6))/(3 ((Abs[x])+(x^2)+2)))))^2)+(x^2)==36

RegionPlot[x^2+(y-(2(x^2+Abs[x]-6))/(3(x^2+Abs[x]+2)))^2<36,{x,-6,6},{y,-8,6}]

eqn=(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)-36/.Abs[x]:>Sqrt[x^2]

Simplify[Numerator[Factor[Expand[eqn]]],x∈Reals]

Solve[9 (x^6)+36 (-32+4 y+(y^2))+(x^4) (-275-12 y+9 (y^2))+(x^2) (-1628+36 y+45 (y^2))+2 (9 (x^4)+6 (-112+4 y+3 (y^2))+(x^2) (-302-12 y+9 (y^2))) Abs[x]==0,Abs[x]]

Numerator[Factor[x^2-((((1152+1628 (x^2)+275 (x^4)-9 (x^6)-144 y-36 (x^2) y+12 (x^4) y-36 (y^2)-45 (x^2) (y^2)-9 (x^4) (y^2))/(2 (-672-302 (x^2)+9 (x^4)+24 y-12 (x^2) y+18 (y^2)+9 (x^2) (y^2)))))^2)]]

Numerator[Factor[Expand[x^2-((1152+1628 (x^2)+275 (x^4)-9 (x^6)-144 y-36 (x^2) y+12 (x^4) y-36 (y^2)-45 (x^2) (y^2)-9 (x^4) (y^2))/(2 (-672-302 (x^2)+9 (x^4)+24 y-12 (x^2) y+18 (y^2)+9 (x^2) (y^2))))^2]]]

RegionPlot[-(-1152+1344 x-1628 x^2+604 x^3-275 x^4-18 x^5+9 x^6+144 y-48 x y+36 x^2 y+24 x^3 y-12 x^4 y+36 y^2-36 x y^2+45 x^2 y^2-18 x^3 y^2+9 x^4 y^2) (-1152-1344 x-1628 x^2-604 x^3-275 x^4+18 x^5+9 x^6+144 y+48 x y+36 x^2 y-24 x^3 y-12 x^4 y+36 y^2+36 x y^2+45 x^2 y^2+18 x^3 y^2+9 x^4 y^2)>0,{x,-6,6},{y,-8,6}]

Plot

Show[{ContourPlot[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)==36,{x,-6,6},{y,-8,6},ContourStyle->{Thick,Red}],ContourPlot[#==0,{x,-6,6},{y,-8,6},PlotPoints->50,MaxRecursion->3]}]&/@{(-1152+1344 x-1628 (x^2)+604 (x^3)-275 (x^4)-18 (x^5)+9 (x^6)+144 y-48 x y+36 (x^2) y+24 (x^3) y-12 (x^4) y+36 (y^2)-36 x (y^2)+45 (x^2) (y^2)-18 (x^3) (y^2)+9 (x^4) (y^2)) ,(-1152-1344 x-1628 (x^2)-604 (x^3)-275 (x^4)+18 (x^5)+9 (x^6)+144 y+48 x y+36 (x^2) y-24 (x^3) y-12 (x^4) y+36 (y^2)+36 x (y^2)+45 (x^2) (y^2)+18 (x^3) (y^2)+9 (x^4) (y^2))}

ContourPlot[-(-1152+1344 x-1628 (x^2)+604 (x^3)-275 (x^4)-18 (x^5)+9 (x^6)+144 y-48 x y+36 (x^2) y+24 (x^3) y-12 (x^4) y+36 (y^2)-36 x (y^2)+45 (x^2) (y^2)-18 (x^3) (y^2)+9 (x^4) (y^2)) (-1152-1344 x-1628 (x^2)-604 (x^3)-275 (x^4)+18 (x^5)+9 (x^6)+144 y+48 x y+36 (x^2) y-24 (x^3) y-12 (x^4) y+36 (y^2)+36 x (y^2)+45 (x^2) (y^2)+18 (x^3) (y^2)+9 (x^4) (y^2))==0,{x,-6,6},{y,-8,6},AspectRatio->Automatic,PlotPoints->50,MaxRecursion->3]

ContourPlot[x^2==((1152+1628 (x^2)+275 (x^4)-9 (x^6)-144 y-36 (x^2) y+12 (x^4) y-36 (y^2)-45 (x^2) (y^2)-9 (x^4) (y^2))/(2 (-672-302 (x^2)+9 (x^4)+24 y-12 (x^2) y+18 (y^2)+9 (x^2) (y^2))))^2,{x,-6,6},{y,-8,6},AspectRatio->Automatic,PlotPoints->50]

ContourPlot[Abs[x]==(1152+1628 (x^2)+275 (x^4)-9 (x^6)-144 y-36 (x^2) y+12 (x^4) y-36 (y^2)-45 (x^2) (y^2)-9 (x^4) (y^2))/(2 (-672-302 (x^2)+9 (x^4)+24 y-12 (x^2) y+18 (y^2)+9 (x^2) (y^2))),{x,-6,6},{y,-8,6},AspectRatio->Automatic,PlotPoints->50]

ContourPlot[9 (x^6)+36 (-32+4 y+(y^2))+(x^4) (-275-12 y+9 (y^2))+(x^2) (-1628+36 y+45 (y^2))+2 (9 (x^4)+6 (-112+4 y+3 (y^2))+(x^2) (-302-12 y+9 (y^2))) Abs[x]==0,{x,-6,6},{y,-8,6},AspectRatio->Automatic]

ContourPlot[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)==36,{x,-6,6},{y,-8,6}]

Area

RegionPlot[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36,{x,-6,6},{y,-8,6}]

Integrate[Boole[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36],{x,-∞,∞},{y,-∞,∞}]

Area[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36,{x,y}]//Timing

AreaInertiaTensor

AreaInertiaTensor[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36,{x,y}]//Timing

expr=(1/(441 (Sqrt[11])))2 (-10752 (Sqrt[11])+78106 (Sqrt[11]) π+21 I (Sqrt[75-I (Sqrt[7])]) π-47 (Sqrt[7 (75-I (Sqrt[7]))]) π-21 I (Sqrt[75+I (Sqrt[7])]) π-47 (Sqrt[7 (75+I (Sqrt[7]))]) π+84 I (Sqrt[75-I (Sqrt[7])]) ArcTan[((3 (Sqrt[7]))/47)]-188 (Sqrt[7 (75-I (Sqrt[7]))]) ArcTan[((3 (Sqrt[7]))/47)]-84 I (Sqrt[75+I (Sqrt[7])]) ArcTan[((3 (Sqrt[7]))/47)]-188 (Sqrt[7 (75+I (Sqrt[7]))]) ArcTan[((3 (Sqrt[7]))/47)]+84 (Sqrt[75+I (Sqrt[7])]) ArcTanh[((175 (3 I+(Sqrt[7])))/(-91 I+39 (Sqrt[7])))]-188 I (Sqrt[7 (75+I (Sqrt[7]))]) ArcTanh[((175 (3 I+(Sqrt[7])))/(-91 I+39 (Sqrt[7])))]-84 (Sqrt[75-I (Sqrt[7])]) ArcTanh[((525 I-175 (Sqrt[7]))/(91 I+39 (Sqrt[7])))]-188 I (Sqrt[7 (75-I (Sqrt[7]))]) ArcTanh[((525 I-175 (Sqrt[7]))/(91 I+39 (Sqrt[7])))]+42 (Sqrt[75+I (Sqrt[7])]) Log[(9/2)]-94 I (Sqrt[7 (75+I (Sqrt[7]))]) Log[(9/2)]+42 (Sqrt[75+I (Sqrt[7])]) Log[64]-94 I (Sqrt[7 (75+I (Sqrt[7]))]) Log[64]-42 (Sqrt[75+I (Sqrt[7])]) Log[-72 (147 I+(Sqrt[7])+12 I (Sqrt[150-2 I (Sqrt[7])]))]+94 I (Sqrt[7 (75+I (Sqrt[7]))]) Log[-72 (147 I+(Sqrt[7])+12 I (Sqrt[150-2 I (Sqrt[7])]))]-42 (Sqrt[75-I (Sqrt[7])]) Log[((147 I)/4)-((Sqrt[7])/4)+3 I (Sqrt[150+2 I (Sqrt[7])])]-94 I (Sqrt[7 (75-I (Sqrt[7]))]) Log[((147 I)/4)-((Sqrt[7])/4)+3 I (Sqrt[150+2 I (Sqrt[7])])]);

FullSimplify//@expr

Together[expr]

FullSimplify[expr]

expr=(1/4851)4 ((429583+8 (Sqrt[154 (3105+2 (Sqrt[766250-77532 I (Sqrt[154])]))])) π+16 (-3696+(Sqrt[77 (-621+91 I (Sqrt[7]))]) Log[Root[1+1732 ((#1)^2)+29199750 ((#1)^4)+1732 ((#1)^6)+((#1)^8)&,4]]+(Sqrt[77 (-621-91 I (Sqrt[7]))]) Log[Root[1+1732 ((#1)^2)+29199750 ((#1)^4)+1732 ((#1)^6)+((#1)^8)&,6]]));

{{expr,0},{0,324 π}}

expr//N//Chop

TrigToExp/@expr

expr2=(1/4851)4 (-59136+429583 π+8 (Sqrt[154 (3105+2 (Sqrt[766250-77532 I (Sqrt[154])]))]) π+ Log[((Root[1+1732 ((#1)^2)+29199750 ((#1)^4)+1732 ((#1)^6)+((#1)^8)&,6])^(16 (Sqrt[77 (-621-91 I (Sqrt[7]))])))((Root[1+1732 ((#1)^2)+29199750 ((#1)^4)+1732 ((#1)^6)+((#1)^8)&,4])^(16 (Sqrt[77 (-621+91 I (Sqrt[7]))])))]);

N[expr2]

RootReduce[((Root[1+1732 ((#1)^2)+29199750 ((#1)^4)+1732 ((#1)^6)+((#1)^8)&,6])^(16 (Sqrt[77 (-621-91 I (Sqrt[7]))])))((Root[1+1732 ((#1)^2)+29199750 ((#1)^4)+1732 ((#1)^6)+((#1)^8)&,4])^(16 (Sqrt[77 (-621+91 I (Sqrt[7]))])))]

N[{{(1/(441 (Sqrt[11])))2 (-10752 (Sqrt[11])+78106 (Sqrt[11]) π+21 I (Sqrt[75-I (Sqrt[7])]) π-47 (Sqrt[7 (75-I (Sqrt[7]))]) π-21 I (Sqrt[75+I (Sqrt[7])]) π-47 (Sqrt[7 (75+I (Sqrt[7]))]) π+84 I (Sqrt[75-I (Sqrt[7])]) ArcTan[((3 (Sqrt[7]))/47)]-188 (Sqrt[7 (75-I (Sqrt[7]))]) ArcTan[((3 (Sqrt[7]))/47)]-84 I (Sqrt[75+I (Sqrt[7])]) ArcTan[((3 (Sqrt[7]))/47)]-188 (Sqrt[7 (75+I (Sqrt[7]))]) ArcTan[((3 (Sqrt[7]))/47)]+84 (Sqrt[75+I (Sqrt[7])]) ArcTanh[((175 (3 I+(Sqrt[7])))/(-91 I+39 (Sqrt[7])))]-188 I (Sqrt[7 (75+I (Sqrt[7]))]) ArcTanh[((175 (3 I+(Sqrt[7])))/(-91 I+39 (Sqrt[7])))]-84 (Sqrt[75-I (Sqrt[7])]) ArcTanh[((525 I-175 (Sqrt[7]))/(91 I+39 (Sqrt[7])))]-188 I (Sqrt[7 (75-I (Sqrt[7]))]) ArcTanh[((525 I-175 (Sqrt[7]))/(91 I+39 (Sqrt[7])))]+42 (Sqrt[75+I (Sqrt[7])]) Log[(9/2)]-94 I (Sqrt[7 (75+I (Sqrt[7]))]) Log[(9/2)]+42 (Sqrt[75+I (Sqrt[7])]) Log[64]-94 I (Sqrt[7 (75+I (Sqrt[7]))]) Log[64]-42 (Sqrt[75+I (Sqrt[7])]) Log[-72 (147 I+(Sqrt[7])+12 I (Sqrt[150-2 I (Sqrt[7])]))]+94 I (Sqrt[7 (75+I (Sqrt[7]))]) Log[-72 (147 I+(Sqrt[7])+12 I (Sqrt[150-2 I (Sqrt[7])]))]-42 (Sqrt[75-I (Sqrt[7])]) Log[((147 I)/4)-((Sqrt[7])/4)+3 I (Sqrt[150+2 I (Sqrt[7])])]-94 I (Sqrt[7 (75-I (Sqrt[7]))]) Log[((147 I)/4)-((Sqrt[7])/4)+3 I (Sqrt[150+2 I (Sqrt[7])])]),0},{0,324 π}}]//Chop

AreaInertiaTensor[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36,{y,x}]//Timing

N[%]

Chop[Rest[%]]

Centroid

Centroid[(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36,{x,y}]//Timing

c={0,(1/462) (16016 π+7 I (Sqrt[11 (75-I (Sqrt[7]))]) π+75 (Sqrt[77 (75-I (Sqrt[7]))]) π-7 I (Sqrt[11 (75+I (Sqrt[7]))]) π+75 (Sqrt[77 (75+I (Sqrt[7]))]) π-28 I (Sqrt[11 (75-I (Sqrt[7]))]) ArcTan[((Sqrt[7])/75)]-300 (Sqrt[77 (75-I (Sqrt[7]))]) ArcTan[((Sqrt[7])/75)]+28 I (Sqrt[11 (75+I (Sqrt[7]))]) ArcTan[((Sqrt[7])/75)]-300 (Sqrt[77 (75+I (Sqrt[7]))]) ArcTan[((Sqrt[7])/75)]+28 I (Sqrt[11 (75+I (Sqrt[7]))]) ArcTan[((259 (3-I (Sqrt[7])))/(41 (-7 I+3 (Sqrt[7]))))]-300 (Sqrt[77 (75+I (Sqrt[7]))]) ArcTan[((259 (3-I (Sqrt[7])))/(41 (-7 I+3 (Sqrt[7]))))]-28 I (Sqrt[11 (75-I (Sqrt[7]))]) ArcTan[((259 (3+I (Sqrt[7])))/(41 (7 I+3 (Sqrt[7]))))]-300 (Sqrt[77 (75-I (Sqrt[7]))]) ArcTan[((259 (3+I (Sqrt[7])))/(41 (7 I+3 (Sqrt[7]))))]-14 (Sqrt[11 (75+I (Sqrt[7]))]) Log[-((147 I)/4)-((Sqrt[7])/4)-3 I (Sqrt[150-2 I (Sqrt[7])])]-150 I (Sqrt[77 (75+I (Sqrt[7]))]) Log[-((147 I)/4)-((Sqrt[7])/4)-3 I (Sqrt[150-2 I (Sqrt[7])])]-14 (Sqrt[11 (75-I (Sqrt[7]))]) Log[((147 I)/4)-((Sqrt[7])/4)+3 I (Sqrt[150+2 I (Sqrt[7])])]+150 I (Sqrt[77 (75-I (Sqrt[7]))]) Log[((147 I)/4)-((Sqrt[7])/4)+3 I (Sqrt[150+2 I (Sqrt[7])])])};

c//N//Chop

FullSimplify[c]//Timing

N[%]

ImplicitCurvature

Simplify[Curvature[eqn,{x,y}],(x|y)∈Reals]

FullSimplify[%,(x|y)∈Reals]

Inflection Points

InflectionPoints[eqn,{x,y}]

(x^2)+(((y-((2((x^2)+Abs[x]-6))/(3((x^2)+Abs[x]+2)))))^2)<36

solns=Solve[Refine[eqn,x>0]==0,y]

Block[{y=solns[[2,1,2]]},Reduce[D[y,x,x]==0&&eqn==0,x,Reals]]

infl1=RootReduce[{x,(1/(3 (4+4 x+5 (x^2)+2 (x^3)+(x^4))))(-24-8 x-6 (x^2)+4 (x^3)+2 (x^4)+3 (Sqrt[576+1152 x+2000 (x^2)+1984 (x^3)+1708 (x^4)+952 (x^5)+455 (x^6)+116 (x^7)+22 (x^8)-4 (x^9)-(x^10)]))}/.x->Root[-2939328+18055872 #1-8394192 ((#1)^2)-54774144 ((#1)^3)-25565652 ((#1)^4)+5054076 ((#1)^5)+2642365 ((#1)^6)+142014 ((#1)^7)+80139 ((#1)^8)+59472 ((#1)^9)+20259 ((#1)^10)+4374 ((#1)^11)+729 ((#1)^12)&,4]]

N[%]

Block[{y=solns[[1,1,2]]},Reduce[D[y,x,x]==0&&eqn==0,x,Reals]]

N[%]

infl2=RootReduce[{x,(1/(3 (4+4 x+5 x^2+2 x^3+x^4)))(-24-8 x-6 x^2+4 x^3+2 x^4-3 Sqrt[576+1152 x+2000 x^2+1984 x^3+1708 x^4+952 x^5+455 x^6+116 x^7+22 x^8-4 x^9-x^10])}/.x->#]&/@{Root[-2939328+18055872 #1-8394192 ((#1)^2)-54774144 ((#1)^3)-25565652 ((#1)^4)+5054076 ((#1)^5)+2642365 ((#1)^6)+142014 ((#1)^7)+80139 ((#1)^8)+59472 ((#1)^9)+20259 ((#1)^10)+4374 ((#1)^11)+729 ((#1)^12)&,5],Root[-2939328+18055872 #1-8394192 ((#1)^2)-54774144 ((#1)^3)-25565652 ((#1)^4)+5054076 ((#1)^5)+2642365 ((#1)^6)+142014 ((#1)^7)+80139 ((#1)^8)+59472 ((#1)^9)+20259 ((#1)^10)+4374 ((#1)^11)+729 ((#1)^12)&,6]}

N[infl2]

infl=Sort[Flatten[{#,{-#[[1]],#[[2]]}}&/@Join[{infl1},infl2],1]]

ContourPlot[9 (x^6)+36 (-32+4 y+(y^2))+(x^4) (-275-12 y+9 (y^2))+(x^2) (-1628+36 y+45 (y^2))+2 (9 (x^4)+6 (-112+4 y+3 (y^2))+(x^2) (-302-12 y+9 (y^2))) Abs[x]==0,{x,-6,6},{y,-8,6},AspectRatio->Automatic,Epilog->{PointSize[.02],Point[infl]}]

Singular Points

SingularPoints[eqn,{x,y}]

Solve[eqn==0/.x->0,y]

Slope

eqn=FullSimplify[Slope[x^2+(y-(2(x^2+(Sqrt[(x^2)])-6))/(3(x^2+(Sqrt[(x^2)])+2)))^2==36,{x,y}],x∈Reals]

FullSimplify[eqn,x<0]

FullSimplify[eqn,x>0]

FullSimplify[Slope[(-1152+1344 x-1628 x^2+604 x^3-275 x^4-18 x^5+9 x^6+144 y-48 x y+36 x^2 y+24 x^3 y-12 x^4 y+36 y^2-36 x y^2+45 x^2 y^2-18 x^3 y^2+9 x^4 y^2) (-1152-1344 x-1628 x^2-604 x^3-275 x^4+18 x^5+9 x^6+144 y+48 x y+36 x^2 y-24 x^3 y-12 x^4 y+36 y^2+36 x y^2+45 x^2 y^2+18 x^3 y^2+9 x^4 y^2)==0,{x,y}]]

HeartCurve4

PolarPlot[2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5))),{t,0,2π}]

ArcLength

(s=ArcLength[2-2Sin[t]+Sin[t]((Sqrt[Abs[Cos[t]]])/(Sin[t]+(7/5))),{t,0,2π}])//Timing

Area

PolarPlot[2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5))),{t,-π/2,π/2}]

{PolarPlot[2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5))),{t,-Pi/2,0}],PolarPlot[2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5))),{t,0,π/2}]}

Numeric

NIntegrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,0,π/2},PrecisionGoal->20,WorkingPrecision->50]

V4.1.5

Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}]//Timing

V4.2.1

Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}]//Timing

V5.2 [CORRECT]

Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}]//Timing

...correct...

FullSimplify[Last[%]]

N[%]

ToRadicals[%3]//TraditionalForm

V6 [WRONG]

Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}]//Timing

N[%]

V7 [WRONG]

Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}]//Timing

V8 [CORRECT]

$Version

(i=Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}])//Timing

N[i]//Chop

(i2=FullSimplify[i])//Timing

N[i2]//Chop

V13 [CORRECT]

$Version

(a=Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,π/2}])//Timing

N[a,20]//Chop

(a2=FullSimplify[a])//Timing

Indefinite V13 [WRONG]

$Version

i=Integrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),t]

...wrong...

f[x_?NumericQ]:=NIntegrate[(((2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))))^2),{t,-π/2,x}]

Plot[f[x],{x,-π/2,π/2}]

Plot[Through[{Re,Im}[i]],{t,-π/2,π/2},PlotStyle->{Red,Yellow},Evaluated->True]

Limit[i,t->π/2,Direction->"FromBelow"]-Limit[i,t->-π/2,Direction->"FromAbove"]

N[%,20]

...wrong...

AreaInertiaTensor

AreaInertiaTensor[(2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))),{t,-π/2,π/2}]//Timing

Centroid

Centroid[(2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))),{t,-π/2,π/2}]//Timing

Curvature

Parametric

abs[x_]:=Sqrt[x^2]

Simplify[Curvature[(2-2Sin[t]+Sin[t]((Sqrt[abs[Cos[t]]])/(Sin[t]+(7/5))))a,t],a>0&&0<t<2π]

Polar

FullSimplify[Curvature[2-2 Sin[q]+Sin[q] Sqrt[abs[Cos[q]]]/(Sin[q]+7/5),q],a>0&&0<q<2π]

Equation

PolarPlot[(2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))),{t,0,2π}]

r=(2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5))));

eq=Numerator[Factor[{x-r Cos[t],y-r Sin[t]}]]

eq2={(((7 x-14 Cos[t]+5 x Sin[t]+4 Cos[t] Sin[t]+10 Cos[t] ((Sin[t])^2)))^2)-25((Cos[t])^3)((Sin[t])^2),(((7 y-14 Sin[t]+5 y Sin[t]+4 ((Sin[t])^2)+10 ((Sin[t])^3)))^2)-25Cos[t]((Sin[t])^4)}

eq3=TrigExpand[eq2]/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)};

eq4=Factor[Together[eq3]]

eq5=Numerator[eq4];

GroebnerBasis[eq5,{x,y},s]

soln=Factor[Resultant[Sequence@@eq5,s,Method->Modular]]

solns=Rest[FactorList[soln]][[All,1]]

ContourPlot[#==0,{x,-1,4},{y,-5,1},Contours->{0},MaxRecursion->4]&/@solns

Show[{
PolarPlot[(2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))),{t,0,2π},PlotStyle->{Thick,Red}],
ContourPlot[#==0,{x,-1,4},{y,-5,1},Contours->{0},MaxRecursion->4]
}]&/@solns

right=38416 (x^8)-19208 (x^10)+2401 (x^12)-76832 (x^8) y+19208 (x^10) y+37632 (x^6) (y^2)-9800 (x^7) (y^2)-18816 (x^8) (y^2)+11956 (x^10) (y^2)-5600 (x^5) (y^3)-152096 (x^6) (y^3)+3500 (x^7) (y^3)+76440 (x^8) (y^3)+8591 (x^4) (y^4)-20400 (x^5) (y^4)+53016 (x^6) (y^4)+24390 (x^8) (y^4)-7200 (x^3) (y^5)-93696 (x^4) (y^5)+10500 (x^5) (y^5)+118680 (x^6) (y^5)-625 (x^2) (y^6)-11400 (x^3) (y^6)+94864 (x^4) (y^6)+26020 (x^6) (y^6)-1600 x (y^7)-18432 (x^2) (y^7)+10500 (x^3) (y^7)+89480 (x^4) (y^7)-800 x (y^8)+51456 (x^2) (y^8)+15265 (x^4) (y^8)+3500 x (y^9)+32640 (x^2) (y^9)+9216 (y^10)+4656 (x^2) (y^10)+4608 (y^11)+576 (y^12);

both=right(right/.x->-x);

Factor[both]

eqn=(38416 (x^8)-19208 (x^10)+2401 (x^12)-76832 (x^8) y+19208 (x^10) y+37632 (x^6) (y^2)+9800 (x^7) (y^2)-18816 (x^8) (y^2)+11956 (x^10) (y^2)+5600 (x^5) (y^3)-152096 (x^6) (y^3)-3500 (x^7) (y^3)+76440 (x^8) (y^3)+8591 (x^4) (y^4)+20400 (x^5) (y^4)+53016 (x^6) (y^4)+24390 (x^8) (y^4)+7200 (x^3) (y^5)-93696 (x^4) (y^5)-10500 (x^5) (y^5)+118680 (x^6) (y^5)-625 (x^2) (y^6)+11400 (x^3) (y^6)+94864 (x^4) (y^6)+26020 (x^6) (y^6)+1600 x (y^7)-18432 (x^2) (y^7)-10500 (x^3) (y^7)+89480 (x^4) (y^7)+800 x (y^8)+51456 (x^2) (y^8)+15265 (x^4) (y^8)-3500 x (y^9)+32640 (x^2) (y^9)+9216 (y^10)+4656 (x^2) (y^10)+4608 (y^11)+576 (y^12)) (38416 (x^8)-19208 (x^10)+2401 (x^12)-76832 (x^8) y+19208 (x^10) y+37632 (x^6) (y^2)-9800 (x^7) (y^2)-18816 (x^8) (y^2)+11956 (x^10) (y^2)-5600 (x^5) (y^3)-152096 (x^6) (y^3)+3500 (x^7) (y^3)+76440 (x^8) (y^3)+8591 (x^4) (y^4)-20400 (x^5) (y^4)+53016 (x^6) (y^4)+24390 (x^8) (y^4)-7200 (x^3) (y^5)-93696 (x^4) (y^5)+10500 (x^5) (y^5)+118680 (x^6) (y^5)-625 (x^2) (y^6)-11400 (x^3) (y^6)+94864 (x^4) (y^6)+26020 (x^6) (y^6)-1600 x (y^7)-18432 (x^2) (y^7)+10500 (x^3) (y^7)+89480 (x^4) (y^7)-800 x (y^8)+51456 (x^2) (y^8)+15265 (x^4) (y^8)+3500 x (y^9)+32640 (x^2) (y^9)+9216 (y^10)+4656 (x^2) (y^10)+4608 (y^11)+576 (y^12));

expanded=Factor[(#a^(24-Exponent[#/.y->x,x]))&/@Expand[eqn]]

expanded=(38416 (a^4) (x^8)-19208 (a^2) (x^10)+2401 (x^12)-76832 (a^3) (x^8) y+19208 a (x^10) y+37632 (a^4) (x^6) (y^2)+9800 (a^3) (x^7) (y^2)-18816 (a^2) (x^8) (y^2)+11956 (x^10) (y^2)+5600 (a^4) (x^5) (y^3)-152096 (a^3) (x^6) (y^3)-3500 (a^2) (x^7) (y^3)+76440 a (x^8) (y^3)+8591 (a^4) (x^4) (y^4)+20400 (a^3) (x^5) (y^4)+53016 (a^2) (x^6) (y^4)+24390 (x^8) (y^4)+7200 (a^4) (x^3) (y^5)-93696 (a^3) (x^4) (y^5)-10500 (a^2) (x^5) (y^5)+118680 a (x^6) (y^5)-625 (a^4) (x^2) (y^6)+11400 (a^3) (x^3) (y^6)+94864 (a^2) (x^4) (y^6)+26020 (x^6) (y^6)+1600 (a^4) x (y^7)-18432 (a^3) (x^2) (y^7)-10500 (a^2) (x^3) (y^7)+89480 a (x^4) (y^7)+800 (a^3) x (y^8)+51456 (a^2) (x^2) (y^8)+15265 (x^4) (y^8)-3500 (a^2) x (y^9)+32640 a (x^2) (y^9)+9216 (a^2) (y^10)+4656 (x^2) (y^10)+4608 a (y^11)+576 (y^12)) (38416 (a^4) (x^8)-19208 (a^2) (x^10)+2401 (x^12)-76832 (a^3) (x^8) y+19208 a (x^10) y+37632 (a^4) (x^6) (y^2)-9800 (a^3) (x^7) (y^2)-18816 (a^2) (x^8) (y^2)+11956 (x^10) (y^2)-5600 (a^4) (x^5) (y^3)-152096 (a^3) (x^6) (y^3)+3500 (a^2) (x^7) (y^3)+76440 a (x^8) (y^3)+8591 (a^4) (x^4) (y^4)-20400 (a^3) (x^5) (y^4)+53016 (a^2) (x^6) (y^4)+24390 (x^8) (y^4)-7200 (a^4) (x^3) (y^5)-93696 (a^3) (x^4) (y^5)+10500 (a^2) (x^5) (y^5)+118680 a (x^6) (y^5)-625 (a^4) (x^2) (y^6)-11400 (a^3) (x^3) (y^6)+94864 (a^2) (x^4) (y^6)+26020 (x^6) (y^6)-1600 (a^4) x (y^7)-18432 (a^3) (x^2) (y^7)+10500 (a^2) (x^3) (y^7)+89480 a (x^4) (y^7)-800 (a^3) x (y^8)+51456 (a^2) (x^2) (y^8)+15265 (x^4) (y^8)+3500 (a^2) x (y^9)+32640 a (x^2) (y^9)+9216 (a^2) (y^10)+4656 (x^2) (y^10)+4608 a (y^11)+576 (y^12));

FullSimplify[expanded/.Thread[{x,y}->(2-2Sin[t]+Sin[t]((Sqrt[Cos[t]])/(Sin[t]+(7/5)))){Cos[t],Sin[t]}],t∈Reals&&a>0]//Timing

AlgebraicDegree[both,{x,y}]

Show[{
PolarPlot[(2-2Sin[t]+Sin[t]((Sqrt[Abs[Cos[t]]])/(Sin[t]+(7/5)))),{t,0,2π},PlotStyle->{Thick,Red},Ticks->None],
ContourPlot[both==0,{x,-4,4},{y,-5,1},Contours->{0},MaxRecursion->4,Ticks->None]
},ImageSize->200]

Slope

Slope[(2-2 Sin[t]+Sin[t] Sqrt[Sqrt[Cos[t]^2]]/(Sin[t]+7/5)) {Cos[t],Sin[t]},t]//FullSimplify[#,t>0]&

Slope[2-2 Sin[q]+Sin[q] Sqrt[Sqrt[Cos[q]^2]]/(Sin[q]+7/5),q]//FullSimplify[#,0<q<2π]&

Slope[(38416 x^8-19208 x^10+2401 x^12-76832 x^8 y+19208 x^10 y+37632 x^6 y^2+9800 x^7 y^2-18816 x^8 y^2+11956 x^10 y^2+5600 x^5 y^3-152096 x^6 y^3-3500 x^7 y^3+76440 x^8 y^3+8591 x^4 y^4+20400 x^5 y^4+53016 x^6 y^4+24390 x^8 y^4+7200 x^3 y^5-93696 x^4 y^5-10500 x^5 y^5+118680 x^6 y^5-625 x^2 y^6+11400 x^3 y^6+94864 x^4 y^6+26020 x^6 y^6+1600 x y^7-18432 x^2 y^7-10500 x^3 y^7+89480 x^4 y^7+800 x y^8+51456 x^2 y^8+15265 x^4 y^8-3500 x y^9+32640 x^2 y^9+9216 y^10+4656 x^2 y^10+4608 y^11+576 y^12) (38416 x^8-19208 x^10+2401 x^12-76832 x^8 y+19208 x^10 y+37632 x^6 y^2-9800 x^7 y^2-18816 x^8 y^2+11956 x^10 y^2-5600 x^5 y^3-152096 x^6 y^3+3500 x^7 y^3+76440 x^8 y^3+8591 x^4 y^4-20400 x^5 y^4+53016 x^6 y^4+24390 x^8 y^4-7200 x^3 y^5-93696 x^4 y^5+10500 x^5 y^5+118680 x^6 y^5-625 x^2 y^6-11400 x^3 y^6+94864 x^4 y^6+26020 x^6 y^6-1600 x y^7-18432 x^2 y^7+10500 x^3 y^7+89480 x^4 y^7-800 x y^8+51456 x^2 y^8+15265 x^4 y^8+3500 x y^9+32640 x^2 y^9+9216 y^10+4656 x^2 y^10+4608 y^11+576 y^12)==0,{x,y}]//FullSimplify

Slope[(38416 x^8-19208 x^10+2401 x^12-76832 x^8 y+19208 x^10 y+37632 x^6 y^2+9800 x^7 y^2-18816 x^8 y^2+11956 x^10 y^2+5600 x^5 y^3-152096 x^6 y^3-3500 x^7 y^3+76440 x^8 y^3+8591 x^4 y^4+20400 x^5 y^4+53016 x^6 y^4+24390 x^8 y^4+7200 x^3 y^5-93696 x^4 y^5-10500 x^5 y^5+118680 x^6 y^5-625 x^2 y^6+11400 x^3 y^6+94864 x^4 y^6+26020 x^6 y^6+1600 x y^7-18432 x^2 y^7-10500 x^3 y^7+89480 x^4 y^7+800 x y^8+51456 x^2 y^8+15265 x^4 y^8-3500 x y^9+32640 x^2 y^9+9216 y^10+4656 x^2 y^10+4608 y^11+576 y^12) (38416 x^8-19208 x^10+2401 x^12-76832 x^8 y+19208 x^10 y+37632 x^6 y^2-9800 x^7 y^2-18816 x^8 y^2+11956 x^10 y^2-5600 x^5 y^3-152096 x^6 y^3+3500 x^7 y^3+76440 x^8 y^3+8591 x^4 y^4-20400 x^5 y^4+53016 x^6 y^4+24390 x^8 y^4-7200 x^3 y^5-93696 x^4 y^5+10500 x^5 y^5+118680 x^6 y^5-625 x^2 y^6-11400 x^3 y^6+94864 x^4 y^6+26020 x^6 y^6-1600 x y^7-18432 x^2 y^7+10500 x^3 y^7+89480 x^4 y^7-800 x y^8+51456 x^2 y^8+15265 x^4 y^8+3500 x y^9+32640 x^2 y^9+9216 y^10+4656 x^2 y^10+4608 y^11+576 y^12)==0,{x,y}]//FullSimplify

ByteCount/@%

SpecialAffineCurvature

ByteCount[k=SpecialAffineCurvature[(2-2 Sin[t]+Sin[t] Sqrt[Sqrt[Cos[t]^2]]/(Sin[t]+7/5)) {Cos[t],Sin[t]},t]]//Timing

ByteCount[k2=Simplify[k,0<t<2π]]//Timing

k2

ByteCount[k2=FullSimplify[k2,0<t<2π]]//Timing

Ran overnight

TangentialAngle

FullSimplify[TangentialAngle[(2-2Sin[t]+Sin[t]((Sqrt[Abs[Cos[t]]])/(Sin[t]+(7/5))))a,t],a>0&&0<t<2π]

Vector Properties

{Plot[Sqrt[Abs[Cos[t]]],{t,0,2π}],Plot[(((((Cos[t])^2)))^(1/4)),{t,0,2π}]}

parm=(2-2 Sin[t]+Sin[t] (((((Cos[t])^2)))^(1/4))/(Sin[t]+7/5)) {Cos[t],Sin[t]};
assum=0<t<2π;
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]]

HeartCurve5

Equation

par[x_]:={16 ((Sin[x])^3),13 Cos[x]-5 Cos[2 x]-2 Cos[3 x]-Cos[4 x]}

Solve[And@@Thread[{x,y}==par[t]],{x,y},t]

FullSimplify[12 Sin[x]-4 Sin[3 x]]

Plot

ParametricPlot[{16 ((Sin[x])^3),13 Cos[x]-5 Cos[2 x]-2 Cos[3 x]-Cos[4 x]},{x,-Pi,Pi},PlotStyle->Red]

ParametricPlot[{12 Sin[x]-4 Sin[3 x],13 Cos[x]-5 Cos[2 x]-2 Cos[3 x]-Cos[4 x]},{x,0,Pi},PlotStyle->Red]

Equations

Cartesian

Thread[{x,y}-par[t]]

eq=Numerator[Factor[Thread[{x,y}-par[t]]]]

eq2=TrigExpand[eq]

eq3=eq2/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)};

eq4=Factor[Together[eq3]]

eq5=Numerator[eq4]

curve=Factor[GroebnerBasis[eq5,{x,y},s]]

xy=-10061824000-3937380544 (x^2)+15918304 (x^4)+8116 (x^6)+(x^8)+4261478400 y-471039744 (x^2) y+597312 (x^4) y+240 (x^6) y-246497280 (y^2)+6081792 (x^2) (y^2)+70464 (x^4) (y^2)-71958528 (y^3)+1818624 (x^2) (y^3)+256 (x^4) (y^3)+2899968 (y^4)+67584 (x^2) (y^4)+589824 (y^5)+16384 (y^6);

ContourPlot[-10061824000-3937380544 (x^2)+15918304 (x^4)+8116 (x^6)+(x^8)+4261478400 y-471039744 (x^2) y+597312 (x^4) y+240 (x^6) y-246497280 (y^2)+6081792 (x^2) (y^2)+70464 (x^4) (y^2)-71958528 (y^3)+1818624 (x^2) (y^3)+256 (x^4) (y^3)+2899968 (y^4)+67584 (x^2) (y^4)+589824 (y^5)+16384 (y^6)==0,{x,-16,16},{y,-17,12}]

AlgebraicDegree[curve[[1]],{x,y}]

Polar

ArcTan[1/Divide@@par[t]]//FullSimplify

Thread[{r Cos[q],r Sin[q]}-par[t]]

eq=Numerator[Factor[%]]

eq2=TrigExpand[eq]

eq3=TrigExpand[{eq,r^2-par[t].par[t]}]/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)};

eq4=Factor[Together[eq3]]

eq5=Numerator[eq4]

curve=Factor[GroebnerBasis[eq5,{r},{s,q}]]

Solve[-10061824000-3937380544 (r^2)+15918304 (r^4)+8116 (r^6)+(r^8)+4261478400 r Sin[q]-471039744 (r^3) Sin[q]+597312 (r^5) Sin[q]+240 (r^7) Sin[q]+3690883264 (r^2) ((Sin[q])^2)-25754816 (r^4) ((Sin[q])^2)+46116 (r^6) ((Sin[q])^2)-4 (r^8) ((Sin[q])^2)+399081216 (r^3) ((Sin[q])^3)+624000 (r^5) ((Sin[q])^3)-464 (r^7) ((Sin[q])^3)+12736480 (r^4) ((Sin[q])^4)-48996 (r^6) ((Sin[q])^4)+6 (r^8) ((Sin[q])^4)-631488 (r^5) ((Sin[q])^5)+208 (r^7) ((Sin[q])^5)+11148 (r^6) ((Sin[q])^6)-4 (r^8) ((Sin[q])^6)+16 (r^7) ((Sin[q])^7)+(r^8) ((Sin[q])^8)==0,r]

PolarPlot[Root[-1287913472000+545469235200 Sin[q] #1+(-267768180736-236216528896 Cos[2 q]) ((#1)^2)+(-21981290496 Sin[q]-12770598912 Sin[3 q]) ((#1)^3)+(1000585728+833173504 Cos[2 q]+203783680 Cos[4 q]) ((#1)^4)+(85840896 Sin[q]+5291520 Sin[3 q]-5051904 Sin[5 q]) ((#1)^5)+(2084384-484560 Cos[2 q]-516384 Cos[4 q]-44592 Cos[6 q]) ((#1)^6)+(3936 Sin[q]+5856 Sin[3 q]+1888 Sin[5 q]-32 Sin[7 q]) ((#1)^7)+(35+56 Cos[2 q]+28 Cos[4 q]+8 Cos[6 q]+Cos[8 q]) ((#1)^8)&,1],{q,-1.52,1.52},WorkingPrecision->20,PlotRange->All]

curve={12 Sin[x]-4 Sin[3 x],13 Cos[x]-5 Cos[2 x]-2 Cos[3 x]-Cos[4 x]}

Arc Length

FullSimplify[#.#&[D[par[t],t]]]

NIntegrate[Sqrt[2304 ((Cos[t])^2) ((Sin[t])^4)+(((-13 Sin[t]+10 Sin[2 t]+6 Sin[3 t]+4 Sin[4 t]))^2)],{t,-π,π}]

2ArcLength[par[t],{t,0,π}]//Timing

TrigExpand[2304 ((Cos[t])^2) ((Sin[t])^4)+(((-13 Sin[t]+10 Sin[2 t]+6 Sin[3 t]+4 Sin[4 t]))^2)]//Factor

NIntegrate[Sqrt[(1/2) (609-92 Cos[t]-389 ((Cos[t])^2)+156 ((Cos[t])^3)-232 ((Cos[t])^4)-16 ((Cos[t])^5)+28 ((Cos[t])^6)-48 ((Cos[t])^7)-16 ((Cos[t])^8)+389 ((Sin[t])^2)-468 Cos[t] ((Sin[t])^2)+1392 ((Cos[t])^2) ((Sin[t])^2)+160 ((Cos[t])^3) ((Sin[t])^2)-420 ((Cos[t])^4) ((Sin[t])^2)+1008 ((Cos[t])^5) ((Sin[t])^2)+448 ((Cos[t])^6) ((Sin[t])^2)-232 ((Sin[t])^4)-80 Cos[t] ((Sin[t])^4)+420 ((Cos[t])^2) ((Sin[t])^4)-1680 ((Cos[t])^3) ((Sin[t])^4)-1120 ((Cos[t])^4) ((Sin[t])^4)-28 ((Sin[t])^6)+336 Cos[t] ((Sin[t])^6)+448 ((Cos[t])^2) ((Sin[t])^6)-16 ((Sin[t])^8))],{t,-π,π}]

2Integrate[Sqrt[(1/2) (609-92 Cos[t]-389 ((Cos[t])^2)+156 ((Cos[t])^3)-232 ((Cos[t])^4)-16 ((Cos[t])^5)+28 ((Cos[t])^6)-48 ((Cos[t])^7)-16 ((Cos[t])^8)+389 ((Sin[t])^2)-468 Cos[t] ((Sin[t])^2)+1392 ((Cos[t])^2) ((Sin[t])^2)+160 ((Cos[t])^3) ((Sin[t])^2)-420 ((Cos[t])^4) ((Sin[t])^2)+1008 ((Cos[t])^5) ((Sin[t])^2)+448 ((Cos[t])^6) ((Sin[t])^2)-232 ((Sin[t])^4)-80 Cos[t] ((Sin[t])^4)+420 ((Cos[t])^2) ((Sin[t])^4)-1680 ((Cos[t])^3) ((Sin[t])^4)-1120 ((Cos[t])^4) ((Sin[t])^4)-28 ((Sin[t])^6)+336 Cos[t] ((Sin[t])^6)+448 ((Cos[t])^2) ((Sin[t])^6)-16 ((Sin[t])^8))],{t,0,π}]//Timing

Arc Length Function

2ArcLength[par[t],t]//Timing

Area

area[{f_,g_},{t_,t0_,t1_},assum___?OptionQ]:=integrate[f D[g,t]-g D[f,t],{t,t0,t1},assum]/2

2FullSimplify[area[par[t],{t,0,π}],0<t<π]

Plot[-8 (52-25 Cos[t]+14 Cos[2 t]-12 Cos[3 t]+Cos[5 t]) ((Sin[t])^2),{t,0,π}]

-NIntegrate[-8 (52-25 Cos[t]+14 Cos[2 t]-12 Cos[3 t]+Cos[5 t]) ((Sin[t])^2),{t,0,π}]

Parametric

-2Area[par[t],{t,0,π}]//Timing

Inequality

N[%]

NIntegrate[Boole[-10061824000-3937380544 (x^2)+15918304 (x^4)+8116 (x^6)+(x^8)+4261478400 y-471039744 (x^2) y+597312 (x^4) y+240 (x^6) y-246497280 (y^2)+6081792 (x^2) (y^2)+70464 (x^4) (y^2)-71958528 (y^3)+1818624 (x^2) (y^3)+256 (x^4) (y^3)+2899968 (y^4)+67584 (x^2) (y^4)+589824 (y^5)+16384 (y^6)<0],{x,-20,20},{y,-20,20}]//Timing

Integrate[Boole[-10061824000-3937380544 (x^2)+15918304 (x^4)+8116 (x^6)+(x^8)+4261478400 y-471039744 (x^2) y+597312 (x^4) y+240 (x^6) y-246497280 (y^2)+6081792 (x^2) (y^2)+70464 (x^4) (y^2)-71958528 (y^3)+1818624 (x^2) (y^3)+256 (x^4) (y^3)+2899968 (y^4)+67584 (x^2) (y^4)+589824 (y^5)+16384 (y^6)<0],{x,-∞,∞},{y,-∞,∞}]//FullSimplify//Timing

Integrate[Boole[-10061824000-3937380544 (x^2)+15918304 (x^4)+8116 (x^6)+(x^8)+4261478400 y-471039744 (x^2) y+597312 (x^4) y+240 (x^6) y-246497280 (y^2)+6081792 (x^2) (y^2)+70464 (x^4) (y^2)-71958528 (y^3)+1818624 (x^2) (y^3)+256 (x^4) (y^3)+2899968 (y^4)+67584 (x^2) (y^4)+589824 (y^5)+16384 (y^6)<0],{y,-∞,∞},{x,-∞,∞}]//FullSimplify//Timing

Curvature

κ=FullSimplify[Curvature[par[t],t],-π<t<π]

Plot[κ,{t,-π,π}]

Implicit

κs=Curvature[xy,{x,y}];//Timing

ByteCount/@κs

κs[[1]]

FullSimplify[κs[[1]]]

ByteCount[%]

Factor[κs[[1]]]

ByteCount[%]

Inflection Points

Numerator[κ]

expr=-5 ((Abs[t])^(13/10)) (4 t ((Cos[t])^4) (120+(21+50 (t^2)) Log[(t^2)])-8 ((Cos[t])^3) (9+50 (t^2)+45 (t^2) Log[(t^2)]) Sin[t]-40 (t^2) Cos[t] (-25+3 Log[(t^2)]) ((Sin[t])^3)-100 (t^3) Log[(t^2)] ((Sin[t])^4)+t (40+7 (-3+25 (t^2)) Log[(t^2)]) ((Sin[2 t])^2));

FindInstance[Numerator[κ]==0&&2.2<t<2.4,t]

FullSimplify[%]

i=InflectionPoints[par[t],t]//FullSimplify

N[%]

par[t]/.t->Root[{(-12-31 Cos[#1]+7 Cos[2 #1]-7 Cos[3 #1]+2 Cos[5 #1]) ((Sin[#1])^2)&,2.2456012131307179684005321596772741194671173211545697112794`30.}]//FullSimplify

Singular Points

par/@{-π,0,π}

N[%]

Limit[par[t],t->0]

Slope

Slope[{16 Sin[t]^3,13 Cos[t]-5 Cos[2 t]-2 Cos[3 t]-Cos[4 t]},t]//FullSimplify

Slope[-10061824000-3937380544 x^2+15918304 x^4+8116 x^6+x^8+4261478400 y-471039744 x^2 y+597312 x^4 y+240 x^6 y-246497280 y^2+6081792 x^2 y^2+70464 x^4 y^2-71958528 y^3+1818624 x^2 y^3+256 x^4 y^3+2899968 y^4+67584 x^2 y^4+589824 y^5+16384 y^6==0,{x,y}]//FullSimplify

Slope[-10061824000-3937380544 x^2+15918304 x^4+8116 x^6+x^8+4261478400 y-471039744 x^2 y+597312 x^4 y+240 x^6 y-246497280 y^2+6081792 x^2 y^2+70464 x^4 y^2-71958528 y^3+1818624 x^2 y^3+256 x^4 y^3+2899968 y^4+67584 x^2 y^4+589824 y^5+16384 y^6==0,{x,y}]//FullSimplify

SpecialAffineCurvature

ByteCount[k=SpecialAffineCurvature[{16 Sin[t]^3,13 Cos[t]-5 Cos[2 t]-2 Cos[3 t]-Cos[4 t]},t]]//Timing

ByteCount[k2=FullSimplify[k,0<t<2π]]//Timing

k2

Tangential Angle

TangentialAngle[par[t],t]

Vector Properties

parm={16 Sin[t]^3,13 Cos[t]-5 Cos[2 t]-2 Cos[3 t]-Cos[4 t]};
assum=-π<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]]

HeartCurve6

From Judith Schroeder
October 16, 2021

Original:

(x^2)+(((y-((((x^2)))^(1/3))))^2)==1

Nondimensionalized:

((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1

((((x^2)))^(1/3))/.x->-1

(x^(2/3))/.x->-1

cartesian=((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1;

reg=ImplicitRegion[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1,{x,y}];

xy=-(a^6) (b^6)+3 (a^4) (b^6) (x^2)-2 (a^2) (b^6) (x^4)+(b^6) (x^6)-6 (a^4) (b^5) (x^2) y+6 (a^2) (b^5) (x^4) y+3 (a^6) (b^4) (y^2)-6 (a^4) (b^4) (x^2) (y^2)+3 (a^2) (b^4) (x^4) (y^2)-2 (a^4) (b^3) (x^2) (y^3)-3 (a^6) (b^2) (y^4)+3 (a^4) (b^2) (x^2) (y^4)+(a^6) (y^6)==0;

Bounds

(x^2)+(((y-((((x^2)))^(1/3))))^2)==1

((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1

Assuming[a>0&&b>0,Simplify@Minimize[{x,((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1},{x,y}]]

Assuming[a>0&&b>0,Simplify@Maximize[{x,((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1},{x,y}]]

Assuming[a>0&&b>0,Simplify@Minimize[{y,((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1},{x,y}]]

Assuming[a>0&&b>0,Simplify@Maximize[{y,((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1},{x,y}]]

Table[ContourPlot[((((x/a)))^2)+((((y/b)-(((((((x/a)))^2)))^(1/3))))^2)==1,{x,-a,a},{y,-b,-Root[23 (b^4)+36 (b^3) #1-54 (b^2) ((#1)^2)-4 b ((#1)^3)+27 ((#1)^4)&,1]},AspectRatio->Automatic,ContourStyle->Red,PlotLabel->{a,b}],{a,.5,2,.5},{b,.5,2,.5}]

AlgebraicEquation

cartesian

Expand[((x^2)/(a^2))+(((-(((((x^2)/(a^2))))^(1/3))+(y/b)))^2)-1/.(((((x^2)/(a^2))))^(1/3))->z]//Together//Numerator

gb=Factor@GroebnerBasis[{-(a^2) (b^2)+(b^2) (x^2)+(a^2) (y^2)-2 (a^2) b y z+(a^2) (b^2) (z^2),x^2-z^3a^2},{x,y},z]

gb[[1]]

AlgebraicDegree[gb[[1]],{x,y}]

Block[{a=1,b=3/2},ContourPlot[-(a^6) (b^6)+3 (a^4) (b^6) (x^2)-2 (a^2) (b^6) (x^4)+(b^6) (x^6)-6 (a^4) (b^5) (x^2) y+6 (a^2) (b^5) (x^4) y+3 (a^6) (b^4) (y^2)-6 (a^4) (b^4) (x^2) (y^2)+3 (a^2) (b^4) (x^4) (y^2)-2 (a^4) (b^3) (x^2) (y^3)-3 (a^6) (b^2) (y^4)+3 (a^4) (b^2) (x^2) (y^4)+(a^6) (y^6)==0,{x,-a,a},{y,-b,-Root[23 (b^4)+36 (b^3) #1-54 (b^2) ((#1)^2)-4 b ((#1)^3)+27 ((#1)^4)&,1]}]]

xy/.{a->1,b->1}

FullSimplify[%]

(x^6)+(((-1+(y^2)))^3)+(x^4) Factor[(-2+3 y (2+y))]+(x^2) Factor[(3+y (-6+y (-6+y (-2+3 y))))]==0

ContourPlot[-1+3 (x^2)-2 (x^4)+(x^6)-6 (x^2) y+6 (x^4) y+3 (y^2)-6 (x^2) (y^2)+3 (x^4) (y^2)-2 (x^2) (y^3)-3 (y^4)+3 (x^2) (y^4)+(y^6)==0,{x,-1,1},{y,-1,-Root[23+36 #1-54 ((#1)^2)-4 ((#1)^3)+27 ((#1)^4)&,1]}]

ArcLength

reg=ImplicitRegion[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1,{x,y}]

RegionPlot[reg]

boundary=ImplicitRegion[(x^2)+(((y-((((x^2)))^(1/3))))^2)==1,{x,y}]

ArcLength[boundary]

Solve for y

{bot,top}=y/.Solve[(x^2)+(((y-((((x^2)))^(1/3))))^2)==1,y]

Plot[#,{x,-1,1}]&/@{bot,top,{bot,top}}

FullSimplify[(Sqrt[D[bot,x]^2+1]),0<x<1]

FullSimplify[(Sqrt[D[top,x]^2+1]),0<x<1]

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

2(NIntegrate[(Sqrt[1+((((2/(3 (x^(1/3))))+(x/(Sqrt[1-(x^2)]))))^2)]),{x,0,1}]+NIntegrate[(Sqrt[1+(((-(2/(3 (x^(1/3))))+(x/(Sqrt[1-(x^2)]))))^2)]),{x,0,1}])

(s=2(Integrate[(Sqrt[1+((((2/(3 (x^(1/3))))+(x/(Sqrt[1-(x^2)]))))^2)]),{x,0,1}]+Integrate[(Sqrt[1+(((-(2/(3 (x^(1/3))))+(x/(Sqrt[1-(x^2)]))))^2)]),{x,0,1}]))//Timing

Integrate[(Sqrt[1+((((2/(3 (x^(1/3))))+(x/(Sqrt[1-(x^2)]))))^2)]),x]

ResourceFunction["IntegrateAlgebraic"][(Sqrt[1+((((2/(3 (x^(1/3))))+(x/(Sqrt[1-(x^2)]))))^2)]),x]

Solve for x

{bot,top}=x/.Solve[(x^2)+(((y-((((x^2)))^(1/3))))^2)==1,x]

ArcLengthFunction

Area

This curve:

reg=ImplicitRegion[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1,{x,y}]

First heart curve:

reg2=ImplicitRegion[-(x^2) (y^3)+(((-1+(x^2)+(y^2)))^3)<=0,{x,y}]

RegionPlot/@{reg,reg2}

Area[reg]//Timing

Assuming[-1<y<1.5,Integrate[Boole[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1],{x,-∞,∞}]]

Solve[(x^2)+(((y-((((x^2)))^(1/3))))^2)==1,y]

Assuming[-1<y<1.5,Integrate[Boole[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1],{y,-∞,∞}]]

Curvature

κ=FullSimplify[Curvature[par[t],t],-π<t<π]

Plot[κ,{t,-π,π}]

Cusps

reg=ImplicitRegion[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1,{x,y}]

cartesian

Solve[cartesian==0/.x->0,y]

RegionPlot[reg,Epilog->{AbsolutePointSize[6],Point[{{0,1},{0,-1}}]}]

ImplicitCurvatue

kappa=Factor@Curvature[xy,{x,y}]

ByteCount/@kappa

kappa[[-1]]

curv=kappa[[-1]]/.{a->1,b->1}

ImplicitSlope

slope1=FullSimplify[Slope[cartesian,{x,y}],a>0&&b>0]

Equal@@%

Block[{a=1,b=1},ContourPlot[((b x (b (((((x^2)/(a^2))))^(1/3)) (2+3 (((((x^2)/(a^2))))^(1/3)))-2 y))/(3 b (x^2)-3 (((a (x^2)))^(2/3)) y)),{x,-1,1},{y,-1,1}]]

slope2=Slope[xy,{x,y}]//Factor

Block[{a=1,b=1},ContourPlot[-(((b^2) x (3 (a^4) (b^4)-4 (a^2) (b^4) (x^2)+3 (b^4) (x^4)-6 (a^4) (b^3) y+12 (a^2) (b^3) (x^2) y-6 (a^4) (b^2) (y^2)+6 (a^2) (b^2) (x^2) (y^2)-2 (a^4) b (y^3)+3 (a^4) (y^4)))/(3 (a^2) (-(a^2) (b^5) (x^2)+(b^5) (x^4)+(a^4) (b^4) y-2 (a^2) (b^4) (x^2) y+(b^4) (x^4) y-(a^2) (b^3) (x^2) (y^2)-2 (a^4) (b^2) (y^3)+2 (a^2) (b^2) (x^2) (y^3)+(a^4) (y^5)))),{x,-1,1},{y,-1,1}]]

InflectionPoints

kappa=Simplify[Curvature[cartesian,{x,y}],a>0&&b>0]

Arbitrary a, b

eqns=Expand@PowerExpand[{cartesian,3 (-2 (a^(4/3)) b ((((x^2)))^(1/3))+((2 b ((((x^2)))^(4/3)))/(a^(2/3)))+9 b (((a (x^2)))^(2/3))+2 (a^2) y-2 (x^2) y)==0}]//FullSimplify

Solve[{xy,-(3 (a^12) (b^4) (88 (a^4) (b^12)+237 (a^2) (b^12) (x^2)-121 (b^12) (x^4)+248 (a^4) (b^11) y+328 (a^2) (b^11) (x^2) y+350 (b^11) (x^4) y-177 (a^4) (b^10) (y^2)-3048 (a^2) (b^10) (x^2) (y^2)+2484 (b^10) (x^4) (y^2)-622 (a^4) (b^9) (y^3)-3166 (a^2) (b^9) (x^2) (y^3)-164 (b^9) (x^4) (y^3)-3129 (a^4) (b^8) (y^4)+6365 (a^2) (b^8) (x^2) (y^4)-8594 (b^8) (x^4) (y^4)-5736 (a^4) (b^7) (y^5)+18030 (a^2) (b^7) (x^2) (y^5)-13890 (b^7) (x^4) (y^5)-3775 (a^4) (b^6) (y^6)+15238 (a^2) (b^6) (x^2) (y^6)-9460 (b^6) (x^4) (y^6)+2156 (a^4) (b^5) (y^7)+4120 (a^2) (b^5) (x^2) (y^7)-2802 (b^5) (x^4) (y^7)+4161 (a^4) (b^4) (y^8)-2658 (a^2) (b^4) (x^2) (y^8)-192 (b^4) (x^4) (y^8)+884 (a^4) (b^3) (y^9)-1900 (a^2) (b^3) (x^2) (y^9)-1266 (a^4) (b^2) (y^10)-320 (a^2) (b^2) (x^2) (y^10)-762 (a^4) b (y^11)-128 (a^4) (y^12)))==0},{x,y},Reals]

FindInstance[eqns,{x,y}]

Solve[((x^(4/3))/(a^(4/3)))+((x^2)/(a^2))-((2 (x^(2/3)) y)/((a^(2/3)) b))+((y^2)/(b^2))==1,y]

FullSimplify[((b (x^(2/3)) (-2 (a^2)+9 (a^(4/3)) (x^(2/3))+2 (x^2)))/(a^(2/3)))+2 (a-x) (a+x) y==0/.y->((b (x^(2/3)))/(a^(2/3)))-((b (Sqrt[(a^2)-(x^2)]))/a)]

Assuming[a>0&&b>0,Solve[((9 (a^(2/3)) b (x^(4/3)))/(Sqrt[(a^2)-(x^2)]))+((2 b (x^2) )/a)==2 a b ,x,Reals]]

With[{a=1,b=1},Root[-64 (a^18)+576 (a^16) ((#1)^2)-2304 (a^14) ((#1)^4)+5376 (a^12) ((#1)^6)+523377 (a^10) ((#1)^8)+8064 (a^8) ((#1)^10)-5376 (a^6) ((#1)^12)+2304 (a^4) ((#1)^14)-576 (a^2) ((#1)^16)+64 ((#1)^18)&,2]]

((b (x^(2/3)))/(a^(2/3)))-((b (Sqrt[(a^2)-(x^2)]))/a)/.x->Root[-64 (a^18)+576 (a^16) ((#1)^2)-2304 (a^14) ((#1)^4)+5376 (a^12) ((#1)^6)+523377 (a^10) ((#1)^8)+8064 (a^8) ((#1)^10)-5376 (a^6) ((#1)^12)+2304 (a^4) ((#1)^14)-576 (a^2) ((#1)^16)+64 ((#1)^18)&,2]//FullSimplify

RegionPlot[reg,Epilog->{AbsolutePointSize[6],Point[{((NumericalApproximation[Root, (RowDefault["0.441", FEExpressionsNumericalApproximationElider]), Root[-4+12 ((#1)^3)+81 ((#1)^4)-12 ((#1)^6)+4 ((#1)^9)&,3], ])^(3/2)),(NumericalApproximation[Root, (RowDefault["-0.515", FEExpressionsNumericalApproximationElider]), Root[883+1602 #1-1134 ((#1)^2)-1596 ((#1)^3)+927 ((#1)^4)+1134 ((#1)^5)-24 ((#1)^6)-180 ((#1)^7)+8 ((#1)^9)&,3], ])}]}]

a==1, b==1

x/.Solve[((9 (a^(2/3)) b (x^(4/3)))/(Sqrt[(a^2)-(x^2)]))+((2 b (x^2) )/a)==2 a b /.{a->1,b->1},x,Reals]//RootReduce

((b (x^(2/3)))/(a^(2/3)))-((b (Sqrt[(a^2)-(x^2)]))/a)/.{a->1,b->1,x->((NumericalApproximation[Root, (RowDefault["0.441", FEExpressionsNumericalApproximationElider]), Root[-4+12 ((#1)^3)+81 ((#1)^4)-12 ((#1)^6)+4 ((#1)^9)&,3], ])^(3/2))}//RootReduce

RegionPlot[reg,Epilog->{AbsolutePointSize[6],Point[{((NumericalApproximation[Root, (RowDefault["0.441", FEExpressionsNumericalApproximationElider]), Root[-4+12 ((#1)^3)+81 ((#1)^4)-12 ((#1)^6)+4 ((#1)^9)&,3], ])^(3/2)),(NumericalApproximation[Root, (RowDefault["-0.515", FEExpressionsNumericalApproximationElider]), Root[883+1602 #1-1134 ((#1)^2)-1596 ((#1)^3)+927 ((#1)^4)+1134 ((#1)^5)-24 ((#1)^6)-180 ((#1)^7)+8 ((#1)^9)&,3], ])}]}]

NormalVector

Assuming[assum,FullSimplify[NormalVector[parm,t]/.xform]]

ParametricEquations

Solve for y

{bot,top}=y/.Solve[(x^2)+(((y-((((x^2)))^(1/3))))^2)==1,y]

Plot[#,{x,-1,1}]&/@{bot,top,{bot,top}}

{bot,top}=Simplify[y/.Solve[cartesian,y],a>0&&b>0]

Block[{a=1,b=1},ParametricPlot[{x,((b ((((a (x^2)))^(1/3))-#(Sqrt[(a^2)-(x^2)])))/a)},{x,-1,1}]&/@{-1,1}]

Show[%,PlotRange->Full]

Solve for x

Assuming[a>0&&b>0,Simplify@Solve[cartesian,x,Reals]]

Polar

FullSimplify[(x^2)+(((y-((((x^2)))^(1/3))))^2)==1/.{x->r Cos[t],y->r Sin[t]},r>0]

reqn=FullSimplify[r/.Solve[%,r]]

Plot[#,{t,0,2π}]&/@reqn

PolarPlot[reqn[[2]],{t,0,2π},AspectRatio->Automatic,PlotStyle->Red]

Plot

ContourPlot[(x^2)+(((y-(((x^2))^(1/3))))^2)==1,{x,-1,1},{y,-1,1.6},AspectRatio->#,ContourStyle->Red]&/@{Automatic,1}

ContourPlot[(x^2)+(((y-(((x^2))^(1/3))))^2)==1,{x,-1,1},{y,-1,1.6},AspectRatio->1,ContourStyle->Red]

Region

reg=ImplicitRegion[(x^2)+(((y-((((x^2)))^(1/3))))^2)<=1,{x,y}]

RegionPlot[reg]

Singular Points

Slope

SpecialAffineCurvature

TangentialAngle

TangentialAngle[par[t],t]

TangentVector

Assuming[assum,FullSimplify[TangentVector[parm,t]/.xform]]

VectorLength

Assuming[assum,FullSimplify[Norm[parm]/.xform]]

HeartCurve7

From Jan Mangaldan <janm@wolfram.com>
Feb 14, 2022
Came out of modifying the parametric equations of a nephroid.

par[t_]:={-Sqrt[2] Sin[t]^3,2 Cos[t]-Cos[t]^2-Cos[t]^3}

ParametricPlot[par[t],{t,0,2Pi},PlotStyle->Red]

Manipulate[ParametricPlot[par[t],{t,0,t0},PlotStyle->Red,PlotRange->{{-1.5,1.5},{-2,.7}}],{t0,.1,2Pi}]

{ParametricPlot[par[t],{t,0,Pi},PlotStyle->Red],ParametricPlot[par[t],{t,Pi,2Pi},PlotStyle->Red]}

Show[%,PlotRange->All]

ArcLength

FullSimplify[#.#&[D[par[t],t]]]

NIntegrate[Sqrt[(((-2+Cos[t] (2+3 Cos[t])))^2) ((Sin[t])^2)+18 ((Cos[t])^2) ((Sin[t])^4)],{t,0,2π}]

par[t_]:={-Sqrt[2] Sin[t]^3,2 Cos[t]-Cos[t]^2-Cos[t]^3}

NIntegrate[Sqrt[(((-2+Cos[t] (2+3 Cos[t])))^2) ((Sin[t])^2)+18 ((Cos[t])^2) ((Sin[t])^4)],{t,0,2π}]

(s=2ArcLength[par[t],{t,0,π}])//Timing

Cos[t] -> v

Expand[18 ((Cos[t])^2) ((Sin[t])^4)+(((-2 Sin[t]+2 Cos[t] Sin[t]+3 ((Cos[t])^2) Sin[t]))^2)]/.{((Sin[t])^2)->1-((Cos[t])^2),((Sin[t])^4)->(((1-((Cos[t])^2)))^2)}//Expand

4-8 Cos[t]+6 ((Cos[t])^2)+20 ((Cos[t])^3)-19 ((Cos[t])^4)-12 ((Cos[t])^5)+9 ((Cos[t])^6)/.Cos[t]->v

NIntegrate[2(Sqrt[((4-8 v+6 (v^2)+20 (v^3)-19 (v^4)-12 (v^5)+9 (v^6))/(1-(v^2)))]),{v,-1,1}]

Factor[((4-8 v+6 (v^2)+20 (v^3)-19 (v^4)-12 (v^5)+9 (v^6))/(1-(v^2)))]

NIntegrate[2(Sqrt[4-8 v+10 (v^2)+12 (v^3)-9 (v^4)]),{v,-1,1}]

Plot[2(Sqrt[4-8 v+10 (v^2)+12 (v^3)-9 (v^4)]),{v,-1,1}]

(i=Integrate[2(Sqrt[4-8 v+10 (v^2)+12 (v^3)-9 (v^4)]),{v,-1,1}])//Timing

ResourceFunction["IntegrateAlgebraic"][(Sqrt[4-8 v+10 (v^2)+12 (v^3)-9 (v^4)]),v]

(i=2Integrate[(Sqrt[4-8 v+10 (v^2)+12 (v^3)-9 (v^4)]),v])//Timing

arclen=(i/.v->1)-(i/.v->-1)

N[arclen,20]

(arclen2=Simplify[i/.v->1]-Simplify[i/.v->-1])//Timing

expr=Expand[FullSimplify[arclen2/.{(NumericalApproximation[Root, (RowDefault["-1.02", FEExpressionsNumericalApproximationElider]), Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,1], ])->a,(NumericalApproximation[Root, (RowDefault["1.76", FEExpressionsNumericalApproximationElider]), Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,2], ])->b,(NumericalApproximation[Root, (RowDefault["0.298", FEExpressionsNumericalApproximationElider])-(RowDefault["0.398", FEExpressionsNumericalApproximationElider]) I, Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,3], ])->c,(NumericalApproximation[Root, (RowDefault["0.298", FEExpressionsNumericalApproximationElider])+(RowDefault["0.398", FEExpressionsNumericalApproximationElider]) I, Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,4], ])->d}]]

Collect[expr,{ 
EllipticPi[((a-d)/(b-d)),ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],-(((b-c) (a-d))/((-a+c) (b-d)))],EllipticPi[((a-d)/(b-d)),ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],-(((b-c) (a-d))/((-a+c) (b-d)))],EllipticPi[((a-d)/(b-d)),ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticPi[((a-d)/(b-d)),ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticF[ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticF[ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],
EllipticE[ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticE[ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))]},Factor]

rules={a->(NumericalApproximation[Root, (RowDefault["-1.02", FEExpressionsNumericalApproximationElider]), Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,1], ]),b->(NumericalApproximation[Root, (RowDefault["1.76", FEExpressionsNumericalApproximationElider]), Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,2], ]),c->(NumericalApproximation[Root, (RowDefault["0.298", FEExpressionsNumericalApproximationElider])-(RowDefault["0.398", FEExpressionsNumericalApproximationElider]) I, Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,3], ]),d->(NumericalApproximation[Root, (RowDefault["0.298", FEExpressionsNumericalApproximationElider])+(RowDefault["0.398", FEExpressionsNumericalApproximationElider]) I, Root[-4+8 #1-10 ((#1)^2)-12 ((#1)^3)+9 ((#1)^4)&,4], ])};

N[expr/.rules,20]

{EllipticE[ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticE[ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))]}/.rules//N

{EllipticF[ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticF[ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))]}/.rules//N

{EllipticPi[((a-d)/(b-d)),ArcSin[(Sqrt[(((-1+a) (b-d))/((-1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))],EllipticPi[((a-d)/(b-d)),ArcSin[(Sqrt[(((1+a) (b-d))/((1+b) (a-d)))])],(((b-c) (a-d))/((a-c) (b-d)))]}/.rules//N

(arclen3=RootReduce[arclen2])//Timing

arclen3//N

(arclen4=FullSimplify[arclen3])//Timing

Weierstrass substitution

FullSimplify[(Sqrt[4-8 Cos[t]+6 ((Cos[t])^2)+20 ((Cos[t])^3)-19 ((Cos[t])^4)-12 ((Cos[t])^5)+9 ((Cos[t])^6)])/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)},s>0]

FullSimplify[(Sqrt[18 ((Cos[t])^2) ((Sin[t])^4)+(((-2 Sin[t]+2 Cos[t] Sin[t]+3 ((Cos[t])^2) Sin[t]))^2)])/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)},s>0]

Tan[#/2]&/@{0,Pi}

Tan[Pi/2]

2NIntegrate[((2 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^3))(2/(1+(s^2))),{s,0,Infinity}]

FullSimplify[2((2 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^3))(2/(1+(s^2)))]

Plot[((8 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^4)),{s,0,10}]

NIntegrate[((8 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^4)),{s,0,Infinity}]

Integrate[((8 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^4)),{s,0,Infinity}]//Timing

Factor[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]

s

ResourceFunction["IntegrateAlgebraic"][((8 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^4)),s]

(arclen=Integrate[((8 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^4)),s])//Timing

arclen2=RootReduce[arclen]

NIntegrate[((8 s (Sqrt[9+12 (s^2)-50 (s^4)+92 (s^6)+(s^8)]))/(((1+(s^2)))^4)),{s,0,Infinity},WorkingPrecision->200]

N[(arclen2/.s->10^9)-(arclen2/.s->0),200]

(lim0=RootReduce[arclen2/.s->0])//Timing

N[lim0,20]

N[arclen2/.s->0,20]

lim0/.{(NumericalApproximation[Root, (RowDefault["1.64", FEExpressionsNumericalApproximationElider])+(RowDefault["0.472", FEExpressionsNumericalApproximationElider]) I, Root[598630258944-7183563107328 ((#1)^2)+42179664822912 ((#1)^4)-161069402026368 ((#1)^6)+465981772381488 ((#1)^8)-1142737030071648 ((#1)^10)+2613681480290232 ((#1)^12)-5822779741367688 ((#1)^14)+12196321291561033 ((#1)^16)-22534238442224168 ((#1)^18)+35254940353663492 ((#1)^20)-46090181286497648 ((#1)^22)+50369571174892438 ((#1)^24)-46090181286497648 ((#1)^26)+35254940353663492 ((#1)^28)-22534238442224168 ((#1)^30)+12196321291561033 ((#1)^32)-5822779741367688 ((#1)^34)+2613681480290232 ((#1)^36)-1142737030071648 ((#1)^38)+465981772381488 ((#1)^40)-161069402026368 ((#1)^42)+42179664822912 ((#1)^44)-7183563107328 ((#1)^46)+598630258944 ((#1)^48)&,48], ])->a,(NumericalApproximation[Root, (RowDefault["0.438", FEExpressionsNumericalApproximationElider])-(RowDefault["0.899", FEExpressionsNumericalApproximationElider]) I, Root[773712-2321136 #1+4640941 ((#1)^2)-5413322 ((#1)^3)+4640941 ((#1)^4)-2321136 ((#1)^5)+773712 ((#1)^6)&,1], ])->b}

(lim1=Normal[Series[arclen2,{s,∞,1}]]/.s->0)//Timing

N[lim1,20]

(lim1=Limit[arclen2,s->Infinity])//Timing

s^2 -> u

NIntegrate[(1/(2(Sqrt[u])))((8 (Sqrt[u]) (Sqrt[9+12 u-50 (u^2)+92 (u^3)+(u^4)]))/(((1+u))^4)),{u,0,Infinity}]

NIntegrate[((4(Sqrt[9+12 u-50 (u^2)+92 (u^3)+(u^4)]))/(((1+u))^4)),{u,0,Infinity}]

Integrate[((4(Sqrt[9+12 u-50 (u^2)+92 (u^3)+(u^4)]))/(((1+u))^4)),{u,0,Infinity}]//Timing

ArcLengthFunction

2MyArcLength[par[t],t]//Timing

Area

area[{f_,g_},{t_,t0_,t1_},assum___?OptionQ]:=Integrate[f D[g,t]-g D[f,t],{t,t0,t1},assum]/2

2FullSimplify[area[a par[t],{t,0,π}],0<t<π]

MyArea[a par[t],{t,0,2π}]

N[%]

Integrate[Boole[-108 (x^2)+52 (x^4)+(x^6)-72 (x^2) y+36 (x^4) y+72 (x^2) (y^2)+6 (x^4) (y^2)+64 (y^3)+64 (x^2) (y^3)+96 (y^4)+12 (x^2) (y^4)+48 (y^5)+8 (y^6)<0],{y,-∞,∞},{x,-∞,∞}]

NIntegrate[Boole[-108 (x^2)+52 (x^4)+(x^6)-72 (x^2) y+36 (x^4) y+72 (x^2) (y^2)+6 (x^4) (y^2)+64 (y^3)+64 (x^2) (y^3)+96 (y^4)+12 (x^2) (y^4)+48 (y^5)+8 (y^6)<0],{y,-∞,∞},{x,-∞,∞}]

CartesianEquation

Thread[{x,y}-par[t]]

eq=Numerator[Factor[Thread[{x,y}-par[t]]]]

eq2=TrigExpand[eq]

eq3=eq2/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)};

eq4=Factor[Together[eq3]]

eq5=Numerator[eq4]

curve=Factor[GroebnerBasis[eq5,{x,y},s]]

xy=-108 (x^2)+52 (x^4)+(x^6)-72 (x^2) y+36 (x^4) y+72 (x^2) (y^2)+6 (x^4) (y^2)+64 (y^3)+64 (x^2) (y^3)+96 (y^4)+12 (x^2) (y^4)+48 (y^5)+8 (y^6);

ContourPlot[-108 (x^2)+52 (x^4)+(x^6)-72 (x^2) y+36 (x^4) y+72 (x^2) (y^2)+6 (x^4) (y^2)+64 (y^3)+64 (x^2) (y^3)+96 (y^4)+12 (x^2) (y^4)+48 (y^5)+8 (y^6)==0,{x,-2,2},{y,-2,1},AspectRatio->Automatic]

AlgebraicDegree[curve[[1]],{x,y}]

Centroid

Centroid[a par[t],{t,0,2π}]

Curvature

κ=FullSimplify[Curvature[a par[t],t],0<t<2π&&a>0]

Plot[κ,{t,-π,π}]

ImplicitCurvature

κs=Curvature[xy,{x,y}];//Timing

ByteCount/@κs

FullSimplify[κs[[1]]//PiecewiseExpand]

FullSimplify[κs[[1]]]

ByteCount[%]

Factor[κs[[1]]]

ByteCount[%]

FullSimplify[κs[[2]]]

ImplicitSlope

Slope[xy,{x,y}]

InflectionPoints

Numerator[κ]

FindInstance[Numerator[κ]==0&&0<=t<2Pi,t,4]//FullSimplify

par[t/.#]&/@infl//FullSimplify

infl=Assuming[0<=t<2Pi,InflectionPoints[par[t],t]]//FullSimplify//Union

ParametricPlot[par[t],{t,0,2π},Epilog->{PointSize[Large],Point[infl]}]

NormalVector

Assuming[assum,FullSimplify[NormalVector[a par[t],t]]]/.Abs[x_]^2:>x^2

PolarEquation

ArcTan[1/Divide@@par[t]]//FullSimplify

Thread[{r Cos[q],r Sin[q]}-par[t]]

eq=Numerator[Factor[%]]

eq2=TrigExpand[eq]

eq3=TrigExpand[{eq,r^2-par[t].par[t]}]/.{Cos[t]->(1-s^2)/(1+s^2),Sin[t]->2 s/(1+s^2)};

eq4=Factor[Together[eq3]]

eq5=Numerator[eq4]

curve=Factor[GroebnerBasis[eq5,{r},{s,q}]]

Simplify[Solve[52 (r^2)+(r^4)-108 ((Cos[q])^2)-72 r Sin[q]+36 (r^3) Sin[q]-32 (r^2) ((Sin[q])^2)+3 (r^4) ((Sin[q])^2)+136 r ((Sin[q])^3)-8 (r^3) ((Sin[q])^3)+76 (r^2) ((Sin[q])^4)+3 (r^4) ((Sin[q])^4)+20 (r^3) ((Sin[q])^5)+(r^4) ((Sin[q])^6)==0,r],0<q<2Pi]

PolarPlot[XXX,{q,-1.52,1.52},WorkingPrecision->20,PlotRange->All]

SingularPoints

SingularPoints[xy,{x,y}]

singularpts=Select[%,Im[#]=={0,0}&]

ParametricPlot[par[t],{t,0,2π},Epilog->{PointSize[Large],Point[N[singularpts,20]]}]

Slope

Slope[a par[t],t]//FullSimplify

SpecialAffineCurvature

ByteCount[k=SpecialAffineCurvature[a par[t],t]]//Timing

ByteCount[k2=FullSimplify[k,0<=t<2π&&a>0]]//Timing

k2

TangentialAngle

TangentialAngle[a par[t],t]

TangentVector

Assuming[assum,FullSimplify[TangentVector[a par[t],t]]]/.Abs[x_]^2:>x^2

VectorLength

assum=0≤t<2Pi&&a>0;

FullSimplify[Assuming[assum,FullSimplify[Norm[a par[t]]]]/.Abs[x_]^2:>x^2]

Bonne Projection

Show[Graphics[ProjectionPlot[Projection[Bonne[85.Degree,0.]]]],AspectRatio->Automatic,ImageSize->200]