Conchoid of Nicomedes

Author

Eric W. Weisstein
June 6, 2014

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

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

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

Initializaton

Equations

Cartesian

eqn1=FullSimplify[Eliminate[{x==(b+a /cos[t])cos[t],y==(b+a/cos[t])sin[t],sin[t]^2+cos[t]^2==1},{cos[t],sin[t]}]]

eqn=(x-a)^2(x^2+y^2)-b^2x^2

Simplify[eqn1[[1]]-eqn2]

Plot

<<Utilities`Typesetting`

Paramatric

ParametricPlot[(1+a Sec[θ]){Cos[θ],Sin[θ]}/.a->1,{θ,0,2π},Exclusions->{π/2,3π/2},PlotRange->2]

ParametricPlot[(1+a Sec[θ]){Cos[θ],Sin[θ]}/.a->1,{θ,0,π/2,3π/2,2π},PlotRange->2]

GraphicsGrid[{With[{eps=10^-5},Function[a,Show[ParametricPlot[(1+a Sec[θ]){Cos[θ],Sin[θ]},Evaluate[{θ,#[[1]]+eps,#[[2]]-eps}],PlotStyle->Red]&/@Partition[Range[0,2,1/2]π,2,1],PlotRange->{{-1,3},{-2,2}},
Ticks->None,PlotLabel->ToExpression["a"]==(a/.HoldPattern[Rational[x__]]:>InlineFraction[x])]]/@{0,1/2,1,3/2,2}
]},ImageSize->400]

Polar

Plot[1+Sec[q]/2,{q,0,2π}]

Function[eps,PolarPlot[1+Sec[q]/2,{q,π/2+eps,3π/2-eps}]]/@{0,10^-5}

GraphicsGrid[{With[{eps=10^-5},Function[a,Show[PolarPlot[1+a Sec[θ],Evaluate[{θ,#[[1]]+eps,#[[2]]-eps}],PlotStyle->Red]&/@Partition[Range[0,2,1/2]π,2,1],PlotRange->{{-1,3},{-2,2}},
Ticks->None,PlotLabel->ToExpression["a"]==(a/.HoldPattern[Rational[x__]]:>InlineFraction[x])]]/@{0,1/2,1,3/2,2}
]},ImageSize->400]

GraphicsGrid[Partition[With[{eps=10^-5},Function[a,Show[PolarPlot[1+a Sec[θ],Evaluate[{θ,#[[1]]+eps,#[[2]]-eps}],PlotStyle->Red]&/@Partition[Range[0,2,1/2]π,2,1],PlotRange->{{-1,3},{-2,2}},
Ticks->None,PlotLabel->ToExpression["a"]==(a/.HoldPattern[Rational[x__]]:>InlineFraction[x])]]/@{0,.005,.1,1/4,1/2,3/4,1,1.1,3/2,2}
],4,4,{1,1},{}],ImageSize->400]

Implicit

<<Graphics`ImplicitPlot`

Show[GraphicsArray[Table[
ImplicitPlot[With[{b=1},-(b^2) (x^2)+(((-a+x))^2) ((x^2)+(y^2))==0],{x,-3,3},
  Ticks->None,
PlotLabel->TraditionalForm[InlineFraction[HoldForm[a],b]==InputForm[a]],
DisplayFunction->Identity,
AspectRatio->Automatic,
PlotRange->{{-1.1,3.1},{-2,2}},
PlotStyle->Red],{a,0,2,1/2}]],GraphicsSpacing->-.05]

Show[
Block[{$DisplayFunction=Identity},
Table[ImplicitPlot[-(b^2) (x^2)+(((-a+x))^2) ((x^2)+(y^2))==0/.b->1,{x,-5,5},AspectRatio->Automatic,Ticks->None,
PlotRange->{{-1.1,3.1},{-2,2}},PlotStyle->Hue[a/2]],
{a,.1,2,.1}]]]

movie=Table[ImplicitPlot[With[{b=1},-(b^2) (x^2)+(((-a+x))^2) ((x^2)+(y^2))==0],{x,-3,3},
  Ticks->None,PlotRange->{{-3.1,3.1},{-2,2}},PlotStyle->Red,
PlotLabel->TraditionalForm[InlineFraction[HoldForm[a],b]==PaddedForm[a,{3,2}]]],{a,-2.,2,.05}]

<<Utilities`GIF`

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

Loop

With[{a=1,b=2.2},
PolarPlot[b+a Sec[t],{t,ArcSec[-b/a],2Pi-ArcSec[-b/a]},
PlotStyle->Red,AspectRatio->Automatic,Ticks->None]
]

With[{a=1,b=2.2},
PolarPlot[b+a Sec[t],{t,ArcSec[-b/a],Pi},
PlotStyle->Red,AspectRatio->Automatic,Ticks->None]
]

Solve[b+a Sec[t]==0,t]

Indefinite Attempt

i=FullSimplify[Integrate[(b+a Sec[t])^2,t]]

i2=i/.t->Pi

i1=FullSimplify[i/.t->ArcSec[-b/a],0<a<b]

FullSimplify[FunctionExpand[-2 Log[Cos[(1/2) ArcSec[-(b/a)]]+Sin[(1/2) ArcSec[-(b/a)]]]],0<a<b]

i1=FullSimplify[b (b ArcSec[-(b/a)]-a ((Sqrt[1-((a^2)/(b^2))])+Log[((b+(Sqrt[-(a^2)+(b^2)]))/b)]-2 I π+Log[(b/(b-(Sqrt[-(a^2)+(b^2)])))])),0<a<b]

FullSimplify[i2-i1,0<a<b]

Half-Range

Numerical

With[{b=1.2,a=1},Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],Pi}]]

With[{b=1.2,a=1},NIntegrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],Pi}]]

v4.2

Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],Pi}]

FullSimplify[%]

%/.{b->1.2,a->1}

v5

Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],Pi}]

%/.{b->1.2,a->1}

Integrate[(b+a Sec[t])^2,{t,x,Pi}]

v6

Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],Pi}]//Timing

Integrate[(b+a Sec[t])^2,{t,x,Pi}]//Timing

Full-Range

v4.2

(1/2)Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],2Pi-ArcSec[-b/a]},Assumptions->0<a<b]

(1/2)Integrate[(b+a Sec[t])^2,{t,x,2Pi-x},Assumptions->0<a<b]/.x->ArcSec[-b/a]

With[{a=1.,b=2.2,x=ArcSec[-2.2/1.]},
NIntegrate[(b+a Sec[t])^2,{t,x,2Pi-x}]/2
]

area=FullSimplify[Integrate[(b+a Sec[t])^2,{t,x,2Pi-x}]/2/.x->ArcSec[-b/a],0<a<b]

%/.{a->1.,b->2.2}

But  ln(b-(Sqrt[(b^2)-(a^2)]))=-ln(b+(Sqrt[(b^2)-(a^2)])), so

eqn=(b^2) ArcCos[(a/b)]+a (Sqrt[-(a^2)+(b^2)])+2a b Log[b-(Sqrt[-(a^2)+(b^2)])]

eqn/.{a->1.,b->2.2}

An equivalent form is

eqn2=b^2 ArcCos[a/b]-2a b Log[((b+(Sqrt[-(a^2)+(b^2)]))/a)]+a Sqrt[b^2-a^2]

eqn2/.{a->1.,b->2.2}

With[{a=1.,b=2.2,x=ArcSec[-2.2/1.]},
{NIntegrate[(b+a Sec[t])^2,{t,x,2Pi-x}]/2,b (-2 I a π+b π-b x+2 a Log[-1+(2/(1+Tan[(x/2)]))])-(a^2) Tan[x]}
]

v5

(1/2)Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],2Pi-ArcSec[-b/a]},Assumptions->0<a<b]//Timing

(1/2)Integrate[(b+a Sec[t])^2,{t,x,2Pi-x},Assumptions->0<a<b]/.x->ArcSec[-b/a]//Timing

v6

(1/2)Integrate[(b+a Sec[t])^2,{t,ArcSec[-b/a],2Pi-ArcSec[-b/a]},Assumptions->0<a<b]//Timing

(1/2)Integrate[(b+a Sec[t])^2,{t,x,2Pi-x},Assumptions->0<a<b]/.x->ArcSec[-b/a]//Timing

Properties

curve=(b+a Sec[t]){Cos[t],Sin[t]};

ArcLength

ArcLength[curve,t,Assumptions->a>0&&b>0&&t>0]

FullSimplify[√((((-(b+a Sec[t]) Sin[t]+a Tan[t]))^2)+(((Cos[t] (b+a Sec[t])+a ((Tan[t])^2)))^2)),0<t<2π&&a>0&&b>0]

Integrate[(Sqrt[(b^2)+2 a b Sec[t]+(a^2) ((Sec[t])^4)]),{t,0,t},Assumptions->a>0&&b>0&&t>0]

Curvature

Parametric

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

Simplify[((b (b+3 a Sec[t]-2 a ((Sec[t])^3)))/((((b^2)+2 a b Sec[t]+(a^2) ((Sec[t])^4)))^(3/2)))/.a->0,b>0]

Plot[((b (b+3 a Sec[t]-2 a ((Sec[t])^3)))/((((b^2)+2 a b Sec[t]+(a^2) ((Sec[t])^4)))^(3/2)))/.{a->1,b->1},{t,0,6π}]

Plot[((b (b+3 a Sec[t]-2 a ((Sec[t])^3)))/((((b^2)+2 a b Sec[t]+(a^2) ((Sec[t])^4)))^(3/2)))/.{a->1,b->1},{t,0,π},PlotRange->.5]

Polar

FullSimplify[Curvature[b+a Sec[q],q],a>0&&π/2<q<3π/2]

Implicit

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

Inflection Points

InflectionPoints[eqn,{x,y}]

Singular Points

SingularPoints[eqn,{x,y}]

Slope

Slope[(b+a Sec[t]){Cos[t],Sin[t]},t]//FullSimplify

Slope[b+a Sec[q],q]//FullSimplify

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

SpecialAffineCurvature

FullSimplify[SpecialAffineCurvature[curve,t],a>0&&b>0&&0<t<2π]

Tangential Angle

TangentialAngle[curve,t,Assumptions->a>0&&b>0&&t>0]

Plot[-(π/2)+t+ArcTan[(((a+b Cos[t]) Cot[t])/a)]/.{a->1,b->1},{t,0,6π}]

Vector Properties

parm=(b+a Sec[t]){Cos[t],Sin[t]};
assum=(a|b)∈Reals&&0<t<2π;
xform={Abs[x_]^(n_/;Mod[n,2]==0):>x^n,Sqrt[x_^(n_/;Mod[n,2]==0)]:>Abs[x]^(n/2)};

VectorLength

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

NormalVector

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

TangentVector

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