Witch of Agnesi

Author

Eric W. Weisstein
December 13, 2018

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

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

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

Equation

Parametric 1

Thread[{x,y}==a TrigExpand[{2 Cot[t],1-Cos[2t]}]]

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

Parametric 2

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

Factor/@GroebnerBasis[{x==2a t,y(1+t^2)==2 a},{x,y},t]

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

Polar

{t,(1/(1+t^2))}

θ->FullSimplify[ArcTan[(1/(t(1+(t^2))))]]

soln=FullSimplify[Solve[θ==ArcCot[t+(t^3)],t]]

PolarPlot[(Sqrt[#.#])&[{t,(1/(1+(t^2)))}]/.soln[[1]],{θ,0,π}]

expr=Expand[#.#&[{t,(1/(1+(t^2)))}]/.soln[[1]]];

expr/.θ->.2

expr2=FullSimplify[expr,0<θ<π]

expr2/.θ->.2

Sqrt[expr2]/.θ->q

FullSimplify[Sqrt[expr2],0<θ<π]

PolarPlot[(Sqrt[expr2]),{θ,0,π}]

Plot

Parametric 1

With[{d=.4},
ParametricPlot[{2 Cot[t],1-Cos[2t]},{t,d,π-d},PlotStyle->Red,AspectRatio->Automatic,Ticks->None,Prolog->{{Dashing[{.02}],Blue,Circle[{0,1},1]}}]
]

{2 Cot[t],1-Cos[2t]}/.t->π/2

Limit[{2 Cot[t],1-Cos[2t]},t->π,Direction->1]

Limit[{2 Cot[t],1-Cos[2t]},t->0,Direction->-1]

Parametric 2

ParametricPlot[2{t,(1/(1+t^2))},{t,-3,3},PlotStyle->Red,AspectRatio->Automatic,Ticks->None]

2{t,(1/(1+t^2))}/.t->0

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

Construction

Solve[{x^2+(y-1)^2==1,y==((1/(1+t^2))/t)x},x,y]

Solve[{x^2+(y-1)^2==1,y==((1/(1+t^2))/t)x},y,x]

Animation

Witch[t_]:=Module[{x=(1/(1+(t^2)+2 (t^4)+(t^6))){t+(t^3),1},y=(1/(1+(t^2)+2 (t^4)+(t^6))),tt=t+t^3},
{
{Blue,Circle[{0,1},1]},
{Purple,Line[{{-100,2},{100,2}}],Line[{{-100,0},{100,0}}]},
PointSize[.02],Point[{0,0}],
Line[{{0,0},2x}],
Dashing[{.01}],
Line[2{x,{tt,1},{tt,0}}],
{Red,Line[2{x,{tt,y}}]},
{Blue,Point[2x]},
{Purple,Point[2{tt,0}],Point[2{tt,1}]},
{Red,Point[2{tt,y}]}
}
]

f={};
movie=Show/@Table[Graphics[{
Witch[x],
AppendTo[f,ParametricPlot[2{t,(1/(1+t^2))},{t,(x-.05)+(x-.05)^3,x+x^3},PlotStyle->Red,DisplayFunction->Identity][[1]]]
},AspectRatio->Automatic,ImageSize->400,PlotRange->{{-4,4},{-.05,2.1}}],{x,-1,1,.05}];

Frames

Show[Take[movie,{1,41,4}]]

Animated GIF

<<Utilities`GIF`;

Export[gifs<>"WitchOfAgnesi.gif",movie]//Timing

Properties

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

Arc Length Function

FullSimplify[(Sqrt[Total[D[PlaneCurveData["AgnesiWitch","ParametricEquations"][a][t],t]^2]]),a>0&&t∈Reals]

$Version

Indefinite integration

2a Integrate[(Sqrt[1+((4 (t^2))/(((1+(t^2)))^4))]),t]//Timing

Factor[1+((4 (t^2))/(((1+(t^2)))^4))]

2a Integrate[((Sqrt[1+8 (t^2)+6 (t^4)+4 (t^6)+(t^8)])/(((1+(t^2)))^2)),t]

Defnite integration from left

2a Integrate[(Sqrt[1+((4 (t^2))/(((1+(t^2)))^4))]),{t,-∞,t}]//Timing

Defnite integration from middle

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

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

Area (between curve and x-axis)

Block[{a=1},RegionPlot[0<=y<=((8 (a^3))/(4 (a^2)+(x^2))),{x,-10,10},{y,-.1,2},MaxRecursion->5]]

Limit[witch[[2]],t-># ∞]&/@{-1,1}

PlaneCurveData["AgnesiWitch","ParametricEquations"][a][t]

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

Integrate[((8 (a^3))/(4 (a^2)+(x^2))),{x,-∞,∞},Assumptions->a>0]

Assuming[a>0,Integrate[Boole[0<=y<=((8 (a^3))/(4 (a^2)+(x^2)))],{x,-∞,∞},{y,-∞,∞}]]

AreaMomentOfInertiaTensor (of region between curve and x-axis)

AreaInertiaMatrix[{x,y},"CoordinateSystem"->"Cartesian"]

Assuming[a>0,Integrate[{{(y^2),-x y},{-x y,(x^2)}}Boole[0<=y<=((8 (a^3))/(4 (a^2)+(x^2)))],{x,-∞,∞},{y,-∞,∞}]]

Integrate[((8 (a^3) (x^2))/(4 (a^2)+(x^2))),{x,-w,w},Assumptions->a>0&&w>0]

Assuming[a>0,Limit[%,w->∞]]

Centroid (of region between curve and x-axis)

Block[{a=1},RegionPlot[0<=y<=((8 (a^3))/(4 (a^2)+(x^2))),{x,-10,10},{y,-.1,2},MaxRecursion->5]]

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

Integrate[((8 (a^3) x)/(4 (a^2)+(x^2))),{x,-w,w},Assumptions->a>0&&w>0]

Curvature

Parametric

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

Polar

FullSimplify[Curvature[a√(-(2/3)+(2/3)^(2/3)/(9 Cot[q]+Sqrt[12+81 Cot[q]^2])^(2/3)+(9 Cot[q]+Sqrt[12+81 Cot[q]^2])^(2/3)/(3 2^(2/3) 3^(1/3))+1/(1/3+(2/3)^(2/3)/(9 Cot[q]+Sqrt[12+81 Cot[q]^2])^(2/3)+(9 Cot[q]+Sqrt[12+81 Cot[q]^2])^(2/3)/(3 2^(2/3) 3^(1/3)))^2),q],0<q<π]//Timing

...either crashed or out of memory...

Implicit

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

Factor[%]

Inflection Points

Factor[D[((8 (a^3))/(4 (a^2)+(x^2))),{x,2}]]

Solve[4 (a^2)-3 (x^2)==0,x]

((8 (a^3))/(4 (a^2)+(x^2)))/.x->2a/Sqrt[3]

Inflection Points

Solve[64 (a^5)-48 (a^3) (x^2)==0,x]

Flatten[{x,y/.Solve[-8 (a^3)+4 (a^2) y+(x^2) y==0,y]}/.x->-((2 a)/(Sqrt[3]))]

Flatten[{x,y/.Solve[-8 (a^3)+4 (a^2) y+(x^2) y==0,y]}/.x->((2 a)/(Sqrt[3]))]

Singular Points

SingularPoints[-8 a^3+4 a^2 y+x^2 y,{x,y}]

Slope

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

FullSimplify[Slope[8 a^3==4 a^2 y+x^2 y,{x,y}]]

Tangential Angle

ϕ==(∫_0^t)s'(t)κ(t)\[DifferentialD]t

TangentialAngle[witch,t]

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

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

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

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

Vector Properties

VectorLength

Assuming[a>0&&t∈Reals,FullSimplify[Norm[2 a {t,1/(1+t^2)}]]]

NormalVector

Assuming[a>0&&t∈Reals,FullSimplify[NormalVector[2 a {t,1/(1+t^2)},t]]]

TangentVector

Assuming[a>0&&t∈Reals,FullSimplify[TangentVector[2 a {t,1/(1+t^2)},t]]]

Visualization

With[{a=1},Manipulate[
Show[{
ParametricPlot[2 a {t,1/(1+t^2)},{t,-3,3},Method->{"AxesInFront"->False}],
Graphics[{
Red,Arrow[{2 a {t,1/(1+t^2)},2 a {t,1/(1+t^2)}+{((2 t)/(Sqrt[1+8 (t^2)+6 (t^4)+4 (t^6)+(t^8)])),(1/(Sqrt[1+((4 (t^2))/(((1+(t^2)))^4))]))}}],
Blue,Arrow[{2 a {t,1/(1+t^2)},2 a {t,1/(1+t^2)}+{(1/(Sqrt[1+((4 (t^2))/(((1+(t^2)))^4))])),-((2 t)/(Sqrt[1+8 (t^2)+6 (t^4)+4 (t^6)+(t^8)]))}}]
}]
},PlotRange->{{-6,6},{-.1,3}}],{{t,0},-3,3}
]]