Watt's Curve

Author

Eric W. Weisstein
May 11, 2008

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

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

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

Plot

vals={a->2.1,b->2.,c->2.5};
PolarPlot[Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2]/.vals,{t,0,Pi},PlotPoints->50,AspectRatio->Automatic,Ticks->None,PlotStyle->Red,ImageSize->Small]

vals={a->2.1,b->2.,c->2.5};
PolarPlot[Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2]/.vals,{t,0,2 Pi},PlotPoints->50,AspectRatio->Automatic,Ticks->None,PlotStyle->Red,ImageSize->Small]

vals={a->2.1,b->2.,c->2.5};
PolarPlot[Evaluate[Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2]{-1,1}/.vals],{t,0,2 Pi},PlotPoints->50,AspectRatio->Automatic,Ticks->None,PlotStyle->Red,ImageSize->Small]

Equation

Factor/@GroebnerBasis[{r^2==b^2-(a Sin[t]+z)^2,x==r Cos[t],y==r Sin[t],x^2+y^2==r^2,z^2==c^2-a^2Cos[t]^2},{x,y},{Cos[t],Sin[t],r,z},MonomialOrder->EliminationOrder]

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

ContourPlot[Evaluate[eqn==0/.{a->2.1,b->2.,c->2.5}],{x,-2,2},{y,-2,2},ContourStyle->Red,ContourShading->False,ImageSize->Medium]

Properties

Arc Length

ArcLength[Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2],{t,0,2π},Assumptions->0<a<c]//Timing

FullSimplify[(Sqrt[(b^2)-((((Sqrt[(c^2)-(a^2) ((Cos[t])^2)])+a Sin[t]))^2)+((((((Sqrt[(c^2)-(a^2) ((Cos[t])^2)])+a Sin[t]))^2) (((a Cos[t]+(((a^2) Cos[t] Sin[t])/(Sqrt[(c^2)-(a^2) ((Cos[t])^2)]))))^2))/((b^2)-((((Sqrt[(c^2)-(a^2) ((Cos[t])^2)])+a Sin[t]))^2)))]),Assumptions->0<a<c&&0<t<2π]

Factor[ExpandAll[(b^2)-((((Sqrt[(c^2)-(a^2) ((Cos[t])^2)])+a Sin[t]))^2)+((((((Sqrt[(c^2)-(a^2) ((Cos[t])^2)])+a Sin[t]))^2) (((a Cos[t]+(((a^2) Cos[t] Sin[t])/(Sqrt[(c^2)-(a^2) ((Cos[t])^2)]))))^2))/((b^2)-((((Sqrt[(c^2)-(a^2) ((Cos[t])^2)])+a Sin[t]))^2)))]]

Area

Half an Inner Loop

RegionPlot[y>0&&Sqrt[x^2+y^2]<Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2]/.{Sin[t]->y/Sqrt[x^2+y^2],Cos[t]->x/Sqrt[x^2+y^2]}/.{a->2.1,b->2.,c->2.5},{x,-2,2},{y,-.2,.2},AspectRatio->Automatic]

(a1=Area[Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2],{t,0,π},Assumptions->0<a<c])//Timing

Expand[a1]

One "Heart"

RegionPlot[Sqrt[x^2+y^2]<Sqrt[b^2-(a Sin[t]-Sqrt[c^2-a^2Cos[t]^2])^2]/.{Sin[t]->y/Sqrt[x^2+y^2],Cos[t]->x/Sqrt[x^2+y^2]}/.{a->2.1,b->2.,c->2.5},{x,-2,2},{y,-.2,2},AspectRatio->Automatic]

RegionPlot[Sqrt[x^2+y^2]<Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2]/.{Sin[t]->y/Sqrt[x^2+y^2],Cos[t]->x/Sqrt[x^2+y^2]}/.{a->2.1,b->2.,c->2.5},{x,-2,2},{y,-2,.2},AspectRatio->Automatic]

region=RegionPlot[(Sqrt[x^2+y^2]<Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2]||Sqrt[x^2+y^2]<Sqrt[b^2-(a Sin[t]-Sqrt[c^2-a^2Cos[t]^2])^2])/.{Sin[t]->y/Sqrt[x^2+y^2],Cos[t]->x/Sqrt[x^2+y^2]}/.{a->2.1,b->2.,c->2.5},{x,-2,2},{y,-2,2},AspectRatio->Automatic,PlotStyle->Hue[.5]]

curve=ContourPlot[Evaluate[eqn==0/.{a->2.1,b->2.,c->2.5}],{x,-2,2},{y,-2,2},ContourStyle->{Dashing[{.04}],Black},ContourShading->False,ImageSize->Medium];

Show[{region,curve},Frame->False,ImageSize->200]

(a2=Area[Sqrt[b^2-(a Sin[t]+Sqrt[c^2-a^2Cos[t]^2])^2],{t,0,2π},Assumptions->0<a<c])//Timing

Enclosed Region

Simplify[2(a2-a1)]